From db22ae6140259dd065fdd80af4cb3c3bab41c184 Mon Sep 17 00:00:00 2001 From: Vincent Laporte Date: Tue, 2 Oct 2018 13:44:46 +0000 Subject: rename test files (do not start by a digit) --- dev/tools/update-compat.py | 2 +- test-suite/bugs/5996.v | 8 - test-suite/bugs/bug_5996.v | 8 + test-suite/bugs/closed/1238.v | 22 - test-suite/bugs/closed/1243.v | 12 - test-suite/bugs/closed/1302.v | 22 - test-suite/bugs/closed/1322.v | 28 - test-suite/bugs/closed/1341.v | 17 - test-suite/bugs/closed/1362.v | 26 - test-suite/bugs/closed/1411.v | 35 - test-suite/bugs/closed/1414.v | 40 - test-suite/bugs/closed/1416.v | 30 - test-suite/bugs/closed/1419.v | 8 - test-suite/bugs/closed/1425.v | 19 - test-suite/bugs/closed/1446.v | 20 - test-suite/bugs/closed/1448.v | 28 - test-suite/bugs/closed/1477.v | 18 - test-suite/bugs/closed/1483.v | 10 - test-suite/bugs/closed/1501.v | 67 -- test-suite/bugs/closed/1507.v | 120 -- test-suite/bugs/closed/1519.v | 23 - test-suite/bugs/closed/1542.v | 40 - test-suite/bugs/closed/1543.v | 100 -- test-suite/bugs/closed/1545.v | 20 - test-suite/bugs/closed/1547.v | 5 - test-suite/bugs/closed/1551.v | 13 - test-suite/bugs/closed/1568.v | 13 - test-suite/bugs/closed/1576.v | 38 - test-suite/bugs/closed/1582.v | 15 - test-suite/bugs/closed/1584.v | 5 - test-suite/bugs/closed/1604.v | 7 - test-suite/bugs/closed/1614.v | 21 - test-suite/bugs/closed/1618.v | 23 - test-suite/bugs/closed/1634.v | 24 - test-suite/bugs/closed/1643.v | 20 - test-suite/bugs/closed/1680.v | 9 - test-suite/bugs/closed/1683.v | 42 - test-suite/bugs/closed/1696.v | 16 - test-suite/bugs/closed/1703.v | 8 - test-suite/bugs/closed/1704.v | 18 - test-suite/bugs/closed/1711.v | 34 - test-suite/bugs/closed/1718.v | 9 - test-suite/bugs/closed/1738.v | 30 - test-suite/bugs/closed/1740.v | 23 - test-suite/bugs/closed/1754.v | 24 - test-suite/bugs/closed/1773.v | 9 - test-suite/bugs/closed/1774.v | 18 - test-suite/bugs/closed/1775.v | 39 - test-suite/bugs/closed/1776.v | 22 - test-suite/bugs/closed/1779.v | 25 - test-suite/bugs/closed/1780.v | 12 - test-suite/bugs/closed/1784.v | 100 -- test-suite/bugs/closed/1787.v | 11 - test-suite/bugs/closed/1791.v | 38 - test-suite/bugs/closed/1834.v | 174 --- test-suite/bugs/closed/1844.v | 217 ---- test-suite/bugs/closed/1850.v | 4 - test-suite/bugs/closed/1859.v | 20 - test-suite/bugs/closed/1865.v | 18 - test-suite/bugs/closed/1891.v | 13 - test-suite/bugs/closed/1898.v | 6 - test-suite/bugs/closed/1900.v | 8 - test-suite/bugs/closed/1901.v | 11 - test-suite/bugs/closed/1905.v | 13 - test-suite/bugs/closed/1907.v | 7 - test-suite/bugs/closed/1912.v | 6 - test-suite/bugs/closed/1915.v | 6 - test-suite/bugs/closed/1918.v | 376 ------- test-suite/bugs/closed/1925.v | 22 - test-suite/bugs/closed/1931.v | 29 - test-suite/bugs/closed/1935.v | 21 - test-suite/bugs/closed/1939.v | 19 - test-suite/bugs/closed/1944.v | 9 - test-suite/bugs/closed/1951.v | 63 -- test-suite/bugs/closed/1962.v | 55 - test-suite/bugs/closed/1963.v | 19 - test-suite/bugs/closed/1977.v | 4 - test-suite/bugs/closed/1981.v | 5 - test-suite/bugs/closed/2001.v | 22 - test-suite/bugs/closed/2006.v | 23 - test-suite/bugs/closed/2016.v | 64 -- test-suite/bugs/closed/2017.v | 15 - test-suite/bugs/closed/2021.v | 25 - test-suite/bugs/closed/2027.v | 11 - test-suite/bugs/closed/2083.v | 27 - test-suite/bugs/closed/2089.v | 17 - test-suite/bugs/closed/2095.v | 19 - test-suite/bugs/closed/2105.v | 2 - test-suite/bugs/closed/2108.v | 22 - test-suite/bugs/closed/2117.v | 56 - test-suite/bugs/closed/2123.v | 11 - test-suite/bugs/closed/2127.v | 8 - test-suite/bugs/closed/2135.v | 9 - test-suite/bugs/closed/2136.v | 61 - test-suite/bugs/closed/2137.v | 52 - test-suite/bugs/closed/2139.v | 24 - test-suite/bugs/closed/2141.v | 16 - test-suite/bugs/closed/2145.v | 20 - test-suite/bugs/closed/2149.v | 7 - test-suite/bugs/closed/2164.v | 334 ------ test-suite/bugs/closed/2181.v | 3 - test-suite/bugs/closed/2193.v | 31 - test-suite/bugs/closed/2230.v | 6 - test-suite/bugs/closed/2231.v | 3 - test-suite/bugs/closed/2243.v | 9 - test-suite/bugs/closed/2244.v | 19 - test-suite/bugs/closed/2245.v | 11 - test-suite/bugs/closed/2250.v | 3 - test-suite/bugs/closed/2251.v | 6 - test-suite/bugs/closed/2255.v | 21 - test-suite/bugs/closed/2262.v | 11 - test-suite/bugs/closed/2281.v | 50 - test-suite/bugs/closed/2295.v | 11 - test-suite/bugs/closed/2299.v | 13 - test-suite/bugs/closed/2300.v | 15 - test-suite/bugs/closed/2303.v | 4 - test-suite/bugs/closed/2304.v | 4 - test-suite/bugs/closed/2307.v | 3 - test-suite/bugs/closed/2310.v | 21 - test-suite/bugs/closed/2319.v | 13 - test-suite/bugs/closed/2320.v | 14 - test-suite/bugs/closed/2342.v | 8 - test-suite/bugs/closed/2347.v | 10 - test-suite/bugs/closed/2350.v | 6 - test-suite/bugs/closed/2353.v | 12 - test-suite/bugs/closed/2360.v | 13 - test-suite/bugs/closed/2362.v | 38 - test-suite/bugs/closed/2375.v | 18 - test-suite/bugs/closed/2378.v | 610 ---------- test-suite/bugs/closed/2388.v | 10 - test-suite/bugs/closed/2393.v | 13 - test-suite/bugs/closed/2404.v | 46 - test-suite/bugs/closed/2406.v | 6 - test-suite/bugs/closed/2417.v | 15 - test-suite/bugs/closed/2428.v | 10 - test-suite/bugs/closed/2447.v | 7 - test-suite/bugs/closed/2456.v | 58 - test-suite/bugs/closed/2464.v | 39 - test-suite/bugs/closed/2467.v | 49 - test-suite/bugs/closed/2473.v | 40 - test-suite/bugs/closed/2584.v | 89 -- test-suite/bugs/closed/2586.v | 6 - test-suite/bugs/closed/2590.v | 20 - test-suite/bugs/closed/2602.v | 8 - test-suite/bugs/closed/2603.v | 33 - test-suite/bugs/closed/2608.v | 34 - test-suite/bugs/closed/2613.v | 18 - test-suite/bugs/closed/2615.v | 17 - test-suite/bugs/closed/2616.v | 7 - test-suite/bugs/closed/2629.v | 22 - test-suite/bugs/closed/2667.v | 11 - test-suite/bugs/closed/2668.v | 6 - test-suite/bugs/closed/2670.v | 29 - test-suite/bugs/closed/2680.v | 17 - test-suite/bugs/closed/2713.v | 17 - test-suite/bugs/closed/2729.v | 115 -- test-suite/bugs/closed/2732.v | 19 - test-suite/bugs/closed/2733.v | 43 - test-suite/bugs/closed/2734.v | 15 - test-suite/bugs/closed/2750.v | 23 - test-suite/bugs/closed/2775.v | 6 - test-suite/bugs/closed/2800.v | 19 - test-suite/bugs/closed/2810.v | 10 - test-suite/bugs/closed/2814.v | 6 - test-suite/bugs/closed/2817.v | 9 - test-suite/bugs/closed/2818.v | 11 - test-suite/bugs/closed/2828.v | 4 - test-suite/bugs/closed/2830.v | 227 ---- test-suite/bugs/closed/2834.v | 4 - test-suite/bugs/closed/2836.v | 39 - test-suite/bugs/closed/2837.v | 15 - test-suite/bugs/closed/2839.v | 10 - test-suite/bugs/closed/2846.v | 3 - test-suite/bugs/closed/2848.v | 10 - test-suite/bugs/closed/2854.v | 7 - test-suite/bugs/closed/2876.v | 11 - test-suite/bugs/closed/2881.v | 7 - test-suite/bugs/closed/2883.v | 35 - test-suite/bugs/closed/2900.v | 28 - test-suite/bugs/closed/2920.v | 2 - test-suite/bugs/closed/2923.v | 12 - test-suite/bugs/closed/2928.v | 11 - test-suite/bugs/closed/2930.v | 12 - test-suite/bugs/closed/2945.v | 5 - test-suite/bugs/closed/2946.v | 8 - test-suite/bugs/closed/2951.v | 2 - test-suite/bugs/closed/2955.v | 52 - test-suite/bugs/closed/2966.v | 79 -- test-suite/bugs/closed/2969.v | 28 - test-suite/bugs/closed/2981.v | 15 - test-suite/bugs/closed/2983.v | 8 - test-suite/bugs/closed/2990.v | 8 - test-suite/bugs/closed/2994.v | 2 - test-suite/bugs/closed/2995.v | 9 - test-suite/bugs/closed/2996.v | 31 - test-suite/bugs/closed/3000.v | 2 - test-suite/bugs/closed/3001.v | 21 - test-suite/bugs/closed/3003.v | 12 - test-suite/bugs/closed/3004.v | 7 - test-suite/bugs/closed/3008.v | 29 - test-suite/bugs/closed/3010b.v | 5 - test-suite/bugs/closed/3016.v | 4 - test-suite/bugs/closed/3017.v | 6 - test-suite/bugs/closed/3022.v | 8 - test-suite/bugs/closed/3023.v | 33 - test-suite/bugs/closed/3036.v | 169 --- test-suite/bugs/closed/3037.v | 11 - test-suite/bugs/closed/3043.v | 4 - test-suite/bugs/closed/3045.v | 34 - test-suite/bugs/closed/3050.v | 7 - test-suite/bugs/closed/3054.v | 10 - test-suite/bugs/closed/3062.v | 5 - test-suite/bugs/closed/3068.v | 64 -- test-suite/bugs/closed/3070.v | 6 - test-suite/bugs/closed/3071.v | 5 - test-suite/bugs/closed/3080.v | 18 - test-suite/bugs/closed/3088.v | 12 - test-suite/bugs/closed/3093.v | 6 - test-suite/bugs/closed/3100.v | 9 - test-suite/bugs/closed/3125.v | 27 - test-suite/bugs/closed/3142.v | 9 - test-suite/bugs/closed/3164.v | 49 - test-suite/bugs/closed/3188.v | 22 - test-suite/bugs/closed/3199.v | 18 - test-suite/bugs/closed/3205.v | 26 - test-suite/bugs/closed/3209.v | 75 -- test-suite/bugs/closed/3210.v | 22 - test-suite/bugs/closed/3212.v | 10 - test-suite/bugs/closed/3217.v | 36 - test-suite/bugs/closed/3228.v | 7 - test-suite/bugs/closed/3230.v | 14 - test-suite/bugs/closed/3242.v | 2 - test-suite/bugs/closed/3249.v | 11 - test-suite/bugs/closed/3251.v | 14 - test-suite/bugs/closed/3257.v | 5 - test-suite/bugs/closed/3258.v | 36 - test-suite/bugs/closed/3259.v | 22 - test-suite/bugs/closed/3260.v | 7 - test-suite/bugs/closed/3262.v | 78 -- test-suite/bugs/closed/3264.v | 45 - test-suite/bugs/closed/3265.v | 6 - test-suite/bugs/closed/3266.v | 3 - test-suite/bugs/closed/3267.v | 47 - test-suite/bugs/closed/3281.v | 5 - test-suite/bugs/closed/3282.v | 7 - test-suite/bugs/closed/3284.v | 23 - test-suite/bugs/closed/3285.v | 7 - test-suite/bugs/closed/3286.v | 41 - test-suite/bugs/closed/3287.v | 19 - test-suite/bugs/closed/3289.v | 27 - test-suite/bugs/closed/3291.v | 9 - test-suite/bugs/closed/3294.v | 6 - test-suite/bugs/closed/3297.v | 12 - test-suite/bugs/closed/3298.v | 22 - test-suite/bugs/closed/3300.v | 7 - test-suite/bugs/closed/3305.v | 13 - test-suite/bugs/closed/3306.v | 12 - test-suite/bugs/closed/3310.v | 11 - test-suite/bugs/closed/3314.v | 148 --- test-suite/bugs/closed/3315.v | 37 - test-suite/bugs/closed/3317.v | 94 -- test-suite/bugs/closed/3319.v | 26 - test-suite/bugs/closed/3320.v | 5 - test-suite/bugs/closed/3321.v | 19 - test-suite/bugs/closed/3322.v | 24 - test-suite/bugs/closed/3323.v | 78 -- test-suite/bugs/closed/3324.v | 48 - test-suite/bugs/closed/3325.v | 48 - test-suite/bugs/closed/3326.v | 19 - test-suite/bugs/closed/3329.v | 94 -- test-suite/bugs/closed/3330.v | 1115 ------------------ test-suite/bugs/closed/3331.v | 31 - test-suite/bugs/closed/3332.v | 6 - test-suite/bugs/closed/3336.v | 9 - test-suite/bugs/closed/3337.v | 4 - test-suite/bugs/closed/3338.v | 4 - test-suite/bugs/closed/3344.v | 59 - test-suite/bugs/closed/3346.v | 4 - test-suite/bugs/closed/3347.v | 40 - test-suite/bugs/closed/3348.v | 6 - test-suite/bugs/closed/3350.v | 121 -- test-suite/bugs/closed/3352.v | 35 - test-suite/bugs/closed/3354.v | 12 - test-suite/bugs/closed/3355.v | 6 - test-suite/bugs/closed/3368.v | 16 - test-suite/bugs/closed/3372.v | 7 - test-suite/bugs/closed/3373.v | 34 - test-suite/bugs/closed/3374.v | 52 - test-suite/bugs/closed/3375.v | 49 - test-suite/bugs/closed/3377.v | 18 - test-suite/bugs/closed/3382.v | 64 -- test-suite/bugs/closed/3383.v | 6 - test-suite/bugs/closed/3386.v | 17 - test-suite/bugs/closed/3387.v | 22 - test-suite/bugs/closed/3388.v | 57 - test-suite/bugs/closed/3390.v | 9 - test-suite/bugs/closed/3392.v | 40 - test-suite/bugs/closed/3393.v | 153 --- test-suite/bugs/closed/3402.v | 7 - test-suite/bugs/closed/3408.v | 163 --- test-suite/bugs/closed/3416.v | 12 - test-suite/bugs/closed/3417.v | 7 - test-suite/bugs/closed/3422.v | 209 ---- test-suite/bugs/closed/3427.v | 196 ---- test-suite/bugs/closed/3428.v | 35 - test-suite/bugs/closed/3439.v | 44 - test-suite/bugs/closed/3441.v | 23 - test-suite/bugs/closed/3446.v | 51 - test-suite/bugs/closed/3453.v | 10 - test-suite/bugs/closed/3454.v | 63 -- test-suite/bugs/closed/3461.v | 5 - test-suite/bugs/closed/3467.v | 6 - test-suite/bugs/closed/3469.v | 29 - test-suite/bugs/closed/3477.v | 9 - test-suite/bugs/closed/3480.v | 48 - test-suite/bugs/closed/3481.v | 70 -- test-suite/bugs/closed/3482.v | 11 - test-suite/bugs/closed/3483.v | 5 - test-suite/bugs/closed/3484.v | 31 - test-suite/bugs/closed/3485.v | 133 --- test-suite/bugs/closed/3487.v | 8 - test-suite/bugs/closed/3490.v | 27 - test-suite/bugs/closed/3491.v | 4 - test-suite/bugs/closed/3495.v | 18 - test-suite/bugs/closed/3505.v | 44 - test-suite/bugs/closed/3509.v | 6 - test-suite/bugs/closed/3510.v | 5 - test-suite/bugs/closed/3513.v | 74 -- test-suite/bugs/closed/3520.v | 12 - test-suite/bugs/closed/3531.v | 54 - test-suite/bugs/closed/3537.v | 12 - test-suite/bugs/closed/3539.v | 66 -- test-suite/bugs/closed/3542.v | 6 - test-suite/bugs/closed/3546.v | 17 - test-suite/bugs/closed/3554.v | 1 - test-suite/bugs/closed/3559.v | 88 -- test-suite/bugs/closed/3560.v | 15 - test-suite/bugs/closed/3561.v | 24 - test-suite/bugs/closed/3562.v | 6 - test-suite/bugs/closed/3563.v | 38 - test-suite/bugs/closed/3566.v | 23 - test-suite/bugs/closed/3567.v | 68 -- test-suite/bugs/closed/3584.v | 16 - test-suite/bugs/closed/3590.v | 12 - test-suite/bugs/closed/3593.v | 10 - test-suite/bugs/closed/3594.v | 51 - test-suite/bugs/closed/3596.v | 19 - test-suite/bugs/closed/3612.v | 54 - test-suite/bugs/closed/3616.v | 3 - test-suite/bugs/closed/3618.v | 103 -- test-suite/bugs/closed/3623.v | 4 - test-suite/bugs/closed/3624.v | 11 - test-suite/bugs/closed/3625.v | 12 - test-suite/bugs/closed/3628.v | 9 - test-suite/bugs/closed/3633.v | 10 - test-suite/bugs/closed/3637.v | 11 - test-suite/bugs/closed/3638.v | 25 - test-suite/bugs/closed/3640.v | 31 - test-suite/bugs/closed/3641.v | 21 - test-suite/bugs/closed/3647.v | 654 ----------- test-suite/bugs/closed/3648.v | 83 -- test-suite/bugs/closed/3649.v | 60 - test-suite/bugs/closed/3652.v | 101 -- test-suite/bugs/closed/3653.v | 13 - test-suite/bugs/closed/3654.v | 7 - test-suite/bugs/closed/3656.v | 53 - test-suite/bugs/closed/3657.v | 12 - test-suite/bugs/closed/3658.v | 75 -- test-suite/bugs/closed/3660.v | 28 - test-suite/bugs/closed/3661.v | 88 -- test-suite/bugs/closed/3662.v | 47 - test-suite/bugs/closed/3664.v | 24 - test-suite/bugs/closed/3665.v | 33 - test-suite/bugs/closed/3666.v | 51 - test-suite/bugs/closed/3667.v | 25 - test-suite/bugs/closed/3668.v | 54 - test-suite/bugs/closed/3670.v | 23 - test-suite/bugs/closed/3672.v | 27 - test-suite/bugs/closed/3675.v | 20 - test-suite/bugs/closed/3681.v | 20 - test-suite/bugs/closed/3682.v | 6 - test-suite/bugs/closed/3684.v | 5 - test-suite/bugs/closed/3685.v | 75 -- test-suite/bugs/closed/3686.v | 63 -- test-suite/bugs/closed/3690.v | 48 - test-suite/bugs/closed/3692.v | 26 - test-suite/bugs/closed/3698.v | 26 - test-suite/bugs/closed/3699.v | 159 --- test-suite/bugs/closed/3700.v | 84 -- test-suite/bugs/closed/3703.v | 32 - test-suite/bugs/closed/3709.v | 24 - test-suite/bugs/closed/3710.v | 48 - test-suite/bugs/closed/3723.v | 6 - test-suite/bugs/closed/3732.v | 105 -- test-suite/bugs/closed/3735.v | 4 - test-suite/bugs/closed/3736.v | 8 - test-suite/bugs/closed/3743.v | 11 - test-suite/bugs/closed/3746.v | 92 -- test-suite/bugs/closed/3753.v | 4 - test-suite/bugs/closed/3755.v | 16 - test-suite/bugs/closed/3777.v | 17 - test-suite/bugs/closed/3779.v | 12 - test-suite/bugs/closed/3782.v | 64 -- test-suite/bugs/closed/3783.v | 33 - test-suite/bugs/closed/3786.v | 33 - test-suite/bugs/closed/3788.v | 6 - test-suite/bugs/closed/3792.v | 4 - test-suite/bugs/closed/3798.v | 12 - test-suite/bugs/closed/3804.v | 12 - test-suite/bugs/closed/3807.v | 33 - test-suite/bugs/closed/3808.v | 3 - test-suite/bugs/closed/3815.v | 9 - test-suite/bugs/closed/3819.v | 9 - test-suite/bugs/closed/3821.v | 3 - test-suite/bugs/closed/3825.v | 24 - test-suite/bugs/closed/3828.v | 2 - test-suite/bugs/closed/3848.v | 22 - test-suite/bugs/closed/3849.v | 8 - test-suite/bugs/closed/3854.v | 22 - test-suite/bugs/closed/3881.v | 35 - test-suite/bugs/closed/3886.v | 23 - test-suite/bugs/closed/3892.v | 8 - test-suite/bugs/closed/3895.v | 22 - test-suite/bugs/closed/3896.v | 4 - test-suite/bugs/closed/3899.v | 11 - test-suite/bugs/closed/3900.v | 13 - test-suite/bugs/closed/3911.v | 26 - test-suite/bugs/closed/3916.v | 3 - test-suite/bugs/closed/3920.v | 7 - test-suite/bugs/closed/3922.v | 85 -- test-suite/bugs/closed/3923.v | 36 - test-suite/bugs/closed/3929.v | 67 -- test-suite/bugs/closed/3938.v | 8 - test-suite/bugs/closed/3943.v | 50 - test-suite/bugs/closed/3944.v | 5 - test-suite/bugs/closed/3948.v | 24 - test-suite/bugs/closed/3953.v | 5 - test-suite/bugs/closed/3956.v | 143 --- test-suite/bugs/closed/3957.v | 6 - test-suite/bugs/closed/3960.v | 26 - test-suite/bugs/closed/3974.v | 7 - test-suite/bugs/closed/3975.v | 8 - test-suite/bugs/closed/3978.v | 27 - test-suite/bugs/closed/3993.v | 3 - test-suite/bugs/closed/3998.v | 24 - test-suite/bugs/closed/4001.v | 18 - test-suite/bugs/closed/4012.v | 5 - test-suite/bugs/closed/4016.v | 12 - test-suite/bugs/closed/4017.v | 8 - test-suite/bugs/closed/4018.v | 3 - test-suite/bugs/closed/4031.v | 14 - test-suite/bugs/closed/4034.v | 25 - test-suite/bugs/closed/4035.v | 13 - test-suite/bugs/closed/4046.v | 6 - test-suite/bugs/closed/4057.v | 210 ---- test-suite/bugs/closed/4069.v | 106 -- test-suite/bugs/closed/4078.v | 14 - test-suite/bugs/closed/4089.v | 375 ------- test-suite/bugs/closed/4095.v | 87 -- test-suite/bugs/closed/4097.v | 65 -- test-suite/bugs/closed/4101.v | 19 - test-suite/bugs/closed/4103.v | 12 - test-suite/bugs/closed/4116.v | 383 ------- test-suite/bugs/closed/4120.v | 5 - test-suite/bugs/closed/4121.v | 18 - test-suite/bugs/closed/4132.v | 31 - test-suite/bugs/closed/4149.v | 4 - test-suite/bugs/closed/4151.v | 403 ------- test-suite/bugs/closed/4161.v | 27 - test-suite/bugs/closed/4165.v | 7 - test-suite/bugs/closed/4187.v | 709 ------------ test-suite/bugs/closed/4190.v | 15 - test-suite/bugs/closed/4191.v | 5 - test-suite/bugs/closed/4193.v | 7 - test-suite/bugs/closed/4198.v | 39 - test-suite/bugs/closed/4202.v | 10 - test-suite/bugs/closed/4203.v | 19 - test-suite/bugs/closed/4205.v | 8 - test-suite/bugs/closed/4214.v | 6 - test-suite/bugs/closed/4216.v | 20 - test-suite/bugs/closed/4217.v | 6 - test-suite/bugs/closed/4221.v | 9 - test-suite/bugs/closed/4232.v | 20 - test-suite/bugs/closed/4234.v | 7 - test-suite/bugs/closed/4240.v | 12 - test-suite/bugs/closed/4250.v | 11 - test-suite/bugs/closed/4251.v | 17 - test-suite/bugs/closed/4254.v | 13 - test-suite/bugs/closed/4256.v | 43 - test-suite/bugs/closed/4272.v | 12 - test-suite/bugs/closed/4273.v | 9 - test-suite/bugs/closed/4276.v | 11 - test-suite/bugs/closed/4280.v | 24 - test-suite/bugs/closed/4283.v | 8 - test-suite/bugs/closed/4284.v | 6 - test-suite/bugs/closed/4287.v | 123 -- test-suite/bugs/closed/4292.v | 7 - test-suite/bugs/closed/4293.v | 7 - test-suite/bugs/closed/4294.v | 31 - test-suite/bugs/closed/4298.v | 7 - test-suite/bugs/closed/4299.v | 12 - test-suite/bugs/closed/4301.v | 13 - test-suite/bugs/closed/4305.v | 17 - test-suite/bugs/closed/4306.v | 32 - test-suite/bugs/closed/4316.v | 3 - test-suite/bugs/closed/4318.v | 2 - test-suite/bugs/closed/4325.v | 5 - test-suite/bugs/closed/4328.v | 6 - test-suite/bugs/closed/4346.v | 2 - test-suite/bugs/closed/4347.v | 17 - test-suite/bugs/closed/4354.v | 11 - test-suite/bugs/closed/4363.v | 9 - test-suite/bugs/closed/4366.v | 15 - test-suite/bugs/closed/4372.v | 20 - test-suite/bugs/closed/4375.v | 107 -- test-suite/bugs/closed/4378.v | 9 - test-suite/bugs/closed/4390.v | 37 - test-suite/bugs/closed/4397.v | 3 - test-suite/bugs/closed/4403.v | 3 - test-suite/bugs/closed/4404.v | 4 - test-suite/bugs/closed/4412.v | 4 - test-suite/bugs/closed/4416.v | 4 - test-suite/bugs/closed/4420.v | 19 - test-suite/bugs/closed/4429.v | 31 - test-suite/bugs/closed/4433.v | 29 - test-suite/bugs/closed/4443.v | 31 - test-suite/bugs/closed/4450.v | 58 - test-suite/bugs/closed/4453.v | 8 - test-suite/bugs/closed/4456.v | 647 ----------- test-suite/bugs/closed/4462.v | 7 - test-suite/bugs/closed/4464.v | 4 - test-suite/bugs/closed/4467.v | 15 - test-suite/bugs/closed/4471.v | 6 - test-suite/bugs/closed/4479.v | 3 - test-suite/bugs/closed/4480.v | 12 - test-suite/bugs/closed/4484.v | 10 - test-suite/bugs/closed/4495.v | 1 - test-suite/bugs/closed/4498.v | 24 - test-suite/bugs/closed/4503.v | 37 - test-suite/bugs/closed/4511.v | 3 - test-suite/bugs/closed/4519.v | 21 - test-suite/bugs/closed/4527.v | 270 ----- test-suite/bugs/closed/4529.v | 45 - test-suite/bugs/closed/4533.v | 230 ---- test-suite/bugs/closed/4538.v | 1 - test-suite/bugs/closed/4544.v | 1009 ----------------- test-suite/bugs/closed/4574.v | 8 - test-suite/bugs/closed/4576.v | 3 - test-suite/bugs/closed/4580.v | 6 - test-suite/bugs/closed/4582.v | 10 - test-suite/bugs/closed/4588.v | 10 - test-suite/bugs/closed/4596.v | 14 - test-suite/bugs/closed/4603.v | 10 - test-suite/bugs/closed/4612.v | 7 - test-suite/bugs/closed/4616.v | 7 - test-suite/bugs/closed/4622.v | 24 - test-suite/bugs/closed/4623.v | 5 - test-suite/bugs/closed/4624.v | 7 - test-suite/bugs/closed/4627.v | 49 - test-suite/bugs/closed/4628.v | 46 - test-suite/bugs/closed/4634.v | 16 - test-suite/bugs/closed/4644.v | 52 - test-suite/bugs/closed/4653.v | 3 - test-suite/bugs/closed/4661.v | 10 - test-suite/bugs/closed/4663.v | 3 - test-suite/bugs/closed/4670.v | 7 - test-suite/bugs/closed/4673.v | 57 - test-suite/bugs/closed/4679.v | 18 - test-suite/bugs/closed/4684.v | 32 - test-suite/bugs/closed/4695.v | 38 - test-suite/bugs/closed/4708.v | 8 - test-suite/bugs/closed/4709.v | 18 - test-suite/bugs/closed/4710.v | 15 - test-suite/bugs/closed/4713.v | 10 - test-suite/bugs/closed/4717.v | 33 - test-suite/bugs/closed/4718.v | 15 - test-suite/bugs/closed/4720.v | 50 - test-suite/bugs/closed/4723.v | 28 - test-suite/bugs/closed/4725.v | 38 - test-suite/bugs/closed/4726.v | 19 - test-suite/bugs/closed/4737.v | 9 - test-suite/bugs/closed/4745.v | 35 - test-suite/bugs/closed/4746.v | 14 - test-suite/bugs/closed/4754.v | 35 - test-suite/bugs/closed/4762.v | 24 - test-suite/bugs/closed/4763.v | 13 - test-suite/bugs/closed/4764.v | 5 - test-suite/bugs/closed/4769.v | 94 -- test-suite/bugs/closed/4772.v | 6 - test-suite/bugs/closed/4780.v | 106 -- test-suite/bugs/closed/4782.v | 26 - test-suite/bugs/closed/4785.v | 34 - test-suite/bugs/closed/4787.v | 9 - test-suite/bugs/closed/4798.v | 3 - test-suite/bugs/closed/4811.v | 1685 ---------------------------- test-suite/bugs/closed/4813.v | 9 - test-suite/bugs/closed/4816.v | 29 - test-suite/bugs/closed/4818.v | 24 - test-suite/bugs/closed/4844.v | 47 - test-suite/bugs/closed/4852.v | 54 - test-suite/bugs/closed/4858.v | 7 - test-suite/bugs/closed/4859.v | 7 - test-suite/bugs/closed/4863.v | 33 - test-suite/bugs/closed/4865.v | 52 - test-suite/bugs/closed/4869.v | 18 - test-suite/bugs/closed/4873.v | 71 -- test-suite/bugs/closed/4877.v | 12 - test-suite/bugs/closed/4880.v | 11 - test-suite/bugs/closed/4893.v | 4 - test-suite/bugs/closed/4904.v | 11 - test-suite/bugs/closed/4932.v | 44 - test-suite/bugs/closed/4955.v | 98 -- test-suite/bugs/closed/4957.v | 6 - test-suite/bugs/closed/4966.v | 10 - test-suite/bugs/closed/4969.v | 11 - test-suite/bugs/closed/4970.v | 3 - test-suite/bugs/closed/5011.v | 2 - test-suite/bugs/closed/5012.v | 17 - test-suite/bugs/closed/5019.v | 5 - test-suite/bugs/closed/5036.v | 10 - test-suite/bugs/closed/5043.v | 8 - test-suite/bugs/closed/5045.v | 3 - test-suite/bugs/closed/5065.v | 6 - test-suite/bugs/closed/5066.v | 7 - test-suite/bugs/closed/5077.v | 8 - test-suite/bugs/closed/5078.v | 5 - test-suite/bugs/closed/5093.v | 11 - test-suite/bugs/closed/5095.v | 5 - test-suite/bugs/closed/5096.v | 219 ---- test-suite/bugs/closed/5097.v | 7 - test-suite/bugs/closed/5123.v | 33 - test-suite/bugs/closed/5127.v | 15 - test-suite/bugs/closed/5145.v | 10 - test-suite/bugs/closed/5149.v | 47 - test-suite/bugs/closed/5153.v | 8 - test-suite/bugs/closed/5161.v | 27 - test-suite/bugs/closed/5177.v | 22 - test-suite/bugs/closed/5180.v | 64 -- test-suite/bugs/closed/5181.v | 3 - test-suite/bugs/closed/5188.v | 5 - test-suite/bugs/closed/5193.v | 14 - test-suite/bugs/closed/5198.v | 39 - test-suite/bugs/closed/5203.v | 5 - test-suite/bugs/closed/5205.v | 6 - test-suite/bugs/closed/5208.v | 222 ---- test-suite/bugs/closed/5215.v | 286 ----- test-suite/bugs/closed/5215_2.v | 8 - test-suite/bugs/closed/5219.v | 10 - test-suite/bugs/closed/5233.v | 2 - test-suite/bugs/closed/5245.v | 18 - test-suite/bugs/closed/5255.v | 24 - test-suite/bugs/closed/5277.v | 11 - test-suite/bugs/closed/5281.v | 6 - test-suite/bugs/closed/5286.v | 9 - test-suite/bugs/closed/5300.v | 39 - test-suite/bugs/closed/5315.v | 10 - test-suite/bugs/closed/5321.v | 18 - test-suite/bugs/closed/5322.v | 14 - test-suite/bugs/closed/5323.v | 26 - test-suite/bugs/closed/5331.v | 11 - test-suite/bugs/closed/5345.v | 7 - test-suite/bugs/closed/5346.v | 29 - test-suite/bugs/closed/5347.v | 10 - test-suite/bugs/closed/5359.v | 218 ---- test-suite/bugs/closed/5365.v | 13 - test-suite/bugs/closed/5368.v | 6 - test-suite/bugs/closed/5372.v | 8 - test-suite/bugs/closed/5377.v | 54 - test-suite/bugs/closed/5401.v | 21 - test-suite/bugs/closed/5414.v | 12 - test-suite/bugs/closed/5434.v | 18 - test-suite/bugs/closed/5435.v | 2 - test-suite/bugs/closed/5449.v | 6 - test-suite/bugs/closed/5460.v | 11 - test-suite/bugs/closed/5470.v | 3 - test-suite/bugs/closed/5476.v | 28 - test-suite/bugs/closed/5486.v | 15 - test-suite/bugs/closed/5487.v | 9 - test-suite/bugs/closed/5500.v | 35 - test-suite/bugs/closed/5501.v | 21 - test-suite/bugs/closed/5522.v | 7 - test-suite/bugs/closed/5523.v | 6 - test-suite/bugs/closed/5526.v | 3 - test-suite/bugs/closed/5532.v | 15 - test-suite/bugs/closed/5539.v | 15 - test-suite/bugs/closed/5547.v | 16 - test-suite/bugs/closed/5550.v | 10 - test-suite/bugs/closed/5578.v | 57 - test-suite/bugs/closed/5598.v | 8 - test-suite/bugs/closed/5608.v | 33 - test-suite/bugs/closed/5618.v | 9 - test-suite/bugs/closed/5641.v | 6 - test-suite/bugs/closed/5666.v | 4 - test-suite/bugs/closed/5671.v | 7 - test-suite/bugs/closed/5683.v | 71 -- test-suite/bugs/closed/5692.v | 88 -- test-suite/bugs/closed/5696.v | 5 - test-suite/bugs/closed/5697.v | 19 - test-suite/bugs/closed/5707.v | 12 - test-suite/bugs/closed/5713.v | 15 - test-suite/bugs/closed/5717.v | 5 - test-suite/bugs/closed/5719.v | 9 - test-suite/bugs/closed/5726.v | 34 - test-suite/bugs/closed/5741.v | 4 - test-suite/bugs/closed/5749.v | 18 - test-suite/bugs/closed/5750.v | 3 - test-suite/bugs/closed/5755.v | 16 - test-suite/bugs/closed/5757.v | 76 -- test-suite/bugs/closed/5761.v | 126 --- test-suite/bugs/closed/5762.v | 34 - test-suite/bugs/closed/5765.v | 3 - test-suite/bugs/closed/5769.v | 20 - test-suite/bugs/closed/5786.v | 29 - test-suite/bugs/closed/5790.v | 7 - test-suite/bugs/closed/5797.v | 213 ---- test-suite/bugs/closed/5845.v | 7 - test-suite/bugs/closed/5940.v | 12 - test-suite/bugs/closed/6070.v | 32 - test-suite/bugs/closed/6129.v | 9 - test-suite/bugs/closed/6191.v | 16 - test-suite/bugs/closed/6297.v | 8 - test-suite/bugs/closed/6313.v | 64 -- test-suite/bugs/closed/6323.v | 9 - test-suite/bugs/closed/6378.v | 18 - test-suite/bugs/closed/6490.v | 4 - test-suite/bugs/closed/6529.v | 16 - test-suite/bugs/closed/6534.v | 7 - test-suite/bugs/closed/6617.v | 34 - test-suite/bugs/closed/6631.v | 7 - test-suite/bugs/closed/6634.v | 6 - test-suite/bugs/closed/6661.v | 259 ----- test-suite/bugs/closed/6677.v | 5 - test-suite/bugs/closed/6770.v | 7 - test-suite/bugs/closed/6774.v | 7 - test-suite/bugs/closed/6775.v | 43 - test-suite/bugs/closed/6878.v | 8 - test-suite/bugs/closed/6910.v | 5 - test-suite/bugs/closed/6951.v | 2 - test-suite/bugs/closed/6956.v | 13 - test-suite/bugs/closed/7011.v | 16 - test-suite/bugs/closed/7068.v | 6 - test-suite/bugs/closed/7076.v | 4 - test-suite/bugs/closed/7092.v | 70 -- test-suite/bugs/closed/7113.v | 10 - test-suite/bugs/closed/7195.v | 12 - test-suite/bugs/closed/7333.v | 39 - test-suite/bugs/closed/7392.v | 9 - test-suite/bugs/closed/7421.v | 39 - test-suite/bugs/closed/7462.v | 13 - test-suite/bugs/closed/7554.v | 12 - test-suite/bugs/closed/7615.v | 19 - test-suite/bugs/closed/7631.v | 21 - test-suite/bugs/closed/7695.v | 20 - test-suite/bugs/closed/7700.v | 9 - test-suite/bugs/closed/7712.v | 4 - test-suite/bugs/closed/7723.v | 58 - test-suite/bugs/closed/7754.v | 21 - test-suite/bugs/closed/7779.v | 15 - test-suite/bugs/closed/7780.v | 16 - test-suite/bugs/closed/7795.v | 65 -- test-suite/bugs/closed/7811.v | 114 -- test-suite/bugs/closed/7854.v | 10 - test-suite/bugs/closed/7867.v | 4 - test-suite/bugs/closed/7900.v | 53 - test-suite/bugs/closed/7903.v | 4 - test-suite/bugs/closed/7967.v | 2 - test-suite/bugs/closed/8004.v | 47 - test-suite/bugs/closed/8081.v | 4 - test-suite/bugs/closed/808_2411.v | 27 - test-suite/bugs/closed/8106.v | 4 - test-suite/bugs/closed/8119.v | 46 - test-suite/bugs/closed/8121.v | 46 - test-suite/bugs/closed/8126.v | 13 - test-suite/bugs/closed/8215.v | 14 - test-suite/bugs/closed/8270.v | 15 - test-suite/bugs/closed/8288.v | 7 - test-suite/bugs/closed/8432.v | 39 - test-suite/bugs/closed/8478.v | 11 - test-suite/bugs/closed/8532.v | 8 - test-suite/bugs/closed/bug_1238.v | 22 + test-suite/bugs/closed/bug_1243.v | 9 + test-suite/bugs/closed/bug_1302.v | 21 + test-suite/bugs/closed/bug_1322.v | 28 + test-suite/bugs/closed/bug_1341.v | 17 + test-suite/bugs/closed/bug_1362.v | 26 + test-suite/bugs/closed/bug_1411.v | 34 + test-suite/bugs/closed/bug_1414.v | 40 + test-suite/bugs/closed/bug_1416.v | 29 + test-suite/bugs/closed/bug_1419.v | 8 + test-suite/bugs/closed/bug_1425.v | 19 + test-suite/bugs/closed/bug_1446.v | 20 + test-suite/bugs/closed/bug_1448.v | 28 + test-suite/bugs/closed/bug_1477.v | 18 + test-suite/bugs/closed/bug_1483.v | 7 + test-suite/bugs/closed/bug_1501.v | 67 ++ test-suite/bugs/closed/bug_1507.v | 119 ++ test-suite/bugs/closed/bug_1519.v | 23 + test-suite/bugs/closed/bug_1542.v | 40 + test-suite/bugs/closed/bug_1543.v | 100 ++ test-suite/bugs/closed/bug_1545.v | 20 + test-suite/bugs/closed/bug_1547.v | 5 + test-suite/bugs/closed/bug_1551.v | 13 + test-suite/bugs/closed/bug_1568.v | 11 + test-suite/bugs/closed/bug_1576.v | 37 + test-suite/bugs/closed/bug_1582.v | 14 + test-suite/bugs/closed/bug_1584.v | 5 + test-suite/bugs/closed/bug_1604.v | 7 + test-suite/bugs/closed/bug_1614.v | 21 + test-suite/bugs/closed/bug_1618.v | 22 + test-suite/bugs/closed/bug_1634.v | 24 + test-suite/bugs/closed/bug_1643.v | 20 + test-suite/bugs/closed/bug_1680.v | 7 + test-suite/bugs/closed/bug_1683.v | 39 + test-suite/bugs/closed/bug_1696.v | 16 + test-suite/bugs/closed/bug_1703.v | 8 + test-suite/bugs/closed/bug_1704.v | 18 + test-suite/bugs/closed/bug_1711.v | 34 + test-suite/bugs/closed/bug_1718.v | 9 + test-suite/bugs/closed/bug_1738.v | 30 + test-suite/bugs/closed/bug_1740.v | 22 + test-suite/bugs/closed/bug_1754.v | 24 + test-suite/bugs/closed/bug_1773.v | 9 + test-suite/bugs/closed/bug_1774.v | 18 + test-suite/bugs/closed/bug_1775.v | 39 + test-suite/bugs/closed/bug_1776.v | 22 + test-suite/bugs/closed/bug_1779.v | 25 + test-suite/bugs/closed/bug_1780.v | 12 + test-suite/bugs/closed/bug_1784.v | 99 ++ test-suite/bugs/closed/bug_1787.v | 9 + test-suite/bugs/closed/bug_1791.v | 38 + test-suite/bugs/closed/bug_1834.v | 174 +++ test-suite/bugs/closed/bug_1844.v | 217 ++++ test-suite/bugs/closed/bug_1850.v | 3 + test-suite/bugs/closed/bug_1859.v | 20 + test-suite/bugs/closed/bug_1865.v | 18 + test-suite/bugs/closed/bug_1891.v | 12 + test-suite/bugs/closed/bug_1898.v | 6 + test-suite/bugs/closed/bug_1900.v | 8 + test-suite/bugs/closed/bug_1901.v | 11 + test-suite/bugs/closed/bug_1905.v | 13 + test-suite/bugs/closed/bug_1907.v | 7 + test-suite/bugs/closed/bug_1912.v | 6 + test-suite/bugs/closed/bug_1915.v | 6 + test-suite/bugs/closed/bug_1918.v | 376 +++++++ test-suite/bugs/closed/bug_1925.v | 22 + test-suite/bugs/closed/bug_1931.v | 29 + test-suite/bugs/closed/bug_1935.v | 21 + test-suite/bugs/closed/bug_1939.v | 19 + test-suite/bugs/closed/bug_1944.v | 9 + test-suite/bugs/closed/bug_1951.v | 63 ++ test-suite/bugs/closed/bug_1962.v | 55 + test-suite/bugs/closed/bug_1963.v | 19 + test-suite/bugs/closed/bug_1977.v | 4 + test-suite/bugs/closed/bug_1981.v | 5 + test-suite/bugs/closed/bug_2001.v | 22 + test-suite/bugs/closed/bug_2006.v | 23 + test-suite/bugs/closed/bug_2016.v | 64 ++ test-suite/bugs/closed/bug_2017.v | 15 + test-suite/bugs/closed/bug_2021.v | 25 + test-suite/bugs/closed/bug_2027.v | 11 + test-suite/bugs/closed/bug_2083.v | 27 + test-suite/bugs/closed/bug_2089.v | 17 + test-suite/bugs/closed/bug_2095.v | 19 + test-suite/bugs/closed/bug_2105.v | 2 + test-suite/bugs/closed/bug_2108.v | 22 + test-suite/bugs/closed/bug_2117.v | 56 + test-suite/bugs/closed/bug_2123.v | 9 + test-suite/bugs/closed/bug_2127.v | 8 + test-suite/bugs/closed/bug_2135.v | 9 + test-suite/bugs/closed/bug_2136.v | 61 + test-suite/bugs/closed/bug_2137.v | 52 + test-suite/bugs/closed/bug_2139.v | 24 + test-suite/bugs/closed/bug_2141.v | 16 + test-suite/bugs/closed/bug_2145.v | 19 + test-suite/bugs/closed/bug_2149.v | 6 + test-suite/bugs/closed/bug_2164.v | 334 ++++++ test-suite/bugs/closed/bug_2181.v | 3 + test-suite/bugs/closed/bug_2193.v | 31 + test-suite/bugs/closed/bug_2230.v | 6 + test-suite/bugs/closed/bug_2231.v | 3 + test-suite/bugs/closed/bug_2243.v | 9 + test-suite/bugs/closed/bug_2244.v | 19 + test-suite/bugs/closed/bug_2245.v | 11 + test-suite/bugs/closed/bug_2250.v | 3 + test-suite/bugs/closed/bug_2251.v | 6 + test-suite/bugs/closed/bug_2255.v | 21 + test-suite/bugs/closed/bug_2262.v | 10 + test-suite/bugs/closed/bug_2281.v | 50 + test-suite/bugs/closed/bug_2295.v | 11 + test-suite/bugs/closed/bug_2299.v | 13 + test-suite/bugs/closed/bug_2300.v | 15 + test-suite/bugs/closed/bug_2303.v | 4 + test-suite/bugs/closed/bug_2304.v | 3 + test-suite/bugs/closed/bug_2307.v | 2 + test-suite/bugs/closed/bug_2310.v | 21 + test-suite/bugs/closed/bug_2319.v | 13 + test-suite/bugs/closed/bug_2320.v | 14 + test-suite/bugs/closed/bug_2342.v | 7 + test-suite/bugs/closed/bug_2347.v | 10 + test-suite/bugs/closed/bug_2350.v | 6 + test-suite/bugs/closed/bug_2353.v | 12 + test-suite/bugs/closed/bug_2360.v | 12 + test-suite/bugs/closed/bug_2362.v | 36 + test-suite/bugs/closed/bug_2375.v | 17 + test-suite/bugs/closed/bug_2378.v | 610 ++++++++++ test-suite/bugs/closed/bug_2388.v | 9 + test-suite/bugs/closed/bug_2393.v | 13 + test-suite/bugs/closed/bug_2404.v | 46 + test-suite/bugs/closed/bug_2406.v | 6 + test-suite/bugs/closed/bug_2417.v | 15 + test-suite/bugs/closed/bug_2428.v | 10 + test-suite/bugs/closed/bug_2447.v | 7 + test-suite/bugs/closed/bug_2456.v | 58 + test-suite/bugs/closed/bug_2464.v | 39 + test-suite/bugs/closed/bug_2467.v | 49 + test-suite/bugs/closed/bug_2473.v | 40 + test-suite/bugs/closed/bug_2584.v | 89 ++ test-suite/bugs/closed/bug_2586.v | 6 + test-suite/bugs/closed/bug_2590.v | 19 + test-suite/bugs/closed/bug_2602.v | 8 + test-suite/bugs/closed/bug_2603.v | 33 + test-suite/bugs/closed/bug_2608.v | 34 + test-suite/bugs/closed/bug_2613.v | 17 + test-suite/bugs/closed/bug_2615.v | 17 + test-suite/bugs/closed/bug_2616.v | 7 + test-suite/bugs/closed/bug_2629.v | 22 + test-suite/bugs/closed/bug_2667.v | 11 + test-suite/bugs/closed/bug_2668.v | 6 + test-suite/bugs/closed/bug_2670.v | 29 + test-suite/bugs/closed/bug_2680.v | 15 + test-suite/bugs/closed/bug_2713.v | 17 + test-suite/bugs/closed/bug_2729.v | 115 ++ test-suite/bugs/closed/bug_2732.v | 19 + test-suite/bugs/closed/bug_2733.v | 43 + test-suite/bugs/closed/bug_2734.v | 15 + test-suite/bugs/closed/bug_2750.v | 23 + test-suite/bugs/closed/bug_2775.v | 6 + test-suite/bugs/closed/bug_2800.v | 19 + test-suite/bugs/closed/bug_2810.v | 10 + test-suite/bugs/closed/bug_2814.v | 6 + test-suite/bugs/closed/bug_2817.v | 9 + test-suite/bugs/closed/bug_2818.v | 11 + test-suite/bugs/closed/bug_2828.v | 4 + test-suite/bugs/closed/bug_2830.v | 227 ++++ test-suite/bugs/closed/bug_2834.v | 4 + test-suite/bugs/closed/bug_2836.v | 39 + test-suite/bugs/closed/bug_2837.v | 15 + test-suite/bugs/closed/bug_2839.v | 10 + test-suite/bugs/closed/bug_2846.v | 3 + test-suite/bugs/closed/bug_2848.v | 10 + test-suite/bugs/closed/bug_2854.v | 7 + test-suite/bugs/closed/bug_2876.v | 11 + test-suite/bugs/closed/bug_2881.v | 7 + test-suite/bugs/closed/bug_2883.v | 35 + test-suite/bugs/closed/bug_2900.v | 28 + test-suite/bugs/closed/bug_2920.v | 2 + test-suite/bugs/closed/bug_2923.v | 12 + test-suite/bugs/closed/bug_2928.v | 11 + test-suite/bugs/closed/bug_2930.v | 12 + test-suite/bugs/closed/bug_2945.v | 5 + test-suite/bugs/closed/bug_2946.v | 8 + test-suite/bugs/closed/bug_2951.v | 2 + test-suite/bugs/closed/bug_2955.v | 52 + test-suite/bugs/closed/bug_2966.v | 79 ++ test-suite/bugs/closed/bug_2969.v | 28 + test-suite/bugs/closed/bug_2981.v | 14 + test-suite/bugs/closed/bug_2983.v | 8 + test-suite/bugs/closed/bug_2990.v | 8 + test-suite/bugs/closed/bug_2994.v | 2 + test-suite/bugs/closed/bug_2995.v | 9 + test-suite/bugs/closed/bug_2996.v | 31 + test-suite/bugs/closed/bug_3000.v | 2 + test-suite/bugs/closed/bug_3001.v | 21 + test-suite/bugs/closed/bug_3003.v | 12 + test-suite/bugs/closed/bug_3004.v | 7 + test-suite/bugs/closed/bug_3008.v | 29 + test-suite/bugs/closed/bug_3010b.v | 5 + test-suite/bugs/closed/bug_3016.v | 4 + test-suite/bugs/closed/bug_3017.v | 6 + test-suite/bugs/closed/bug_3022.v | 8 + test-suite/bugs/closed/bug_3023.v | 33 + test-suite/bugs/closed/bug_3036.v | 169 +++ test-suite/bugs/closed/bug_3037.v | 11 + test-suite/bugs/closed/bug_3043.v | 4 + test-suite/bugs/closed/bug_3045.v | 34 + test-suite/bugs/closed/bug_3050.v | 7 + test-suite/bugs/closed/bug_3054.v | 10 + test-suite/bugs/closed/bug_3062.v | 5 + test-suite/bugs/closed/bug_3068.v | 64 ++ test-suite/bugs/closed/bug_3070.v | 6 + test-suite/bugs/closed/bug_3071.v | 5 + test-suite/bugs/closed/bug_3080.v | 18 + test-suite/bugs/closed/bug_3088.v | 12 + test-suite/bugs/closed/bug_3093.v | 6 + test-suite/bugs/closed/bug_3100.v | 9 + test-suite/bugs/closed/bug_3125.v | 27 + test-suite/bugs/closed/bug_3142.v | 9 + test-suite/bugs/closed/bug_3164.v | 49 + test-suite/bugs/closed/bug_3188.v | 22 + test-suite/bugs/closed/bug_3199.v | 18 + test-suite/bugs/closed/bug_3205.v | 26 + test-suite/bugs/closed/bug_3209.v | 74 ++ test-suite/bugs/closed/bug_3210.v | 22 + test-suite/bugs/closed/bug_3212.v | 10 + test-suite/bugs/closed/bug_3217.v | 36 + test-suite/bugs/closed/bug_3228.v | 7 + test-suite/bugs/closed/bug_3230.v | 14 + test-suite/bugs/closed/bug_3242.v | 1 + test-suite/bugs/closed/bug_3249.v | 11 + test-suite/bugs/closed/bug_3251.v | 14 + test-suite/bugs/closed/bug_3257.v | 5 + test-suite/bugs/closed/bug_3258.v | 36 + test-suite/bugs/closed/bug_3259.v | 22 + test-suite/bugs/closed/bug_3260.v | 7 + test-suite/bugs/closed/bug_3262.v | 78 ++ test-suite/bugs/closed/bug_3264.v | 45 + test-suite/bugs/closed/bug_3265.v | 6 + test-suite/bugs/closed/bug_3266.v | 3 + test-suite/bugs/closed/bug_3267.v | 47 + test-suite/bugs/closed/bug_3281.v | 5 + test-suite/bugs/closed/bug_3282.v | 7 + test-suite/bugs/closed/bug_3284.v | 23 + test-suite/bugs/closed/bug_3285.v | 7 + test-suite/bugs/closed/bug_3286.v | 41 + test-suite/bugs/closed/bug_3287.v | 19 + test-suite/bugs/closed/bug_3289.v | 27 + test-suite/bugs/closed/bug_3291.v | 9 + test-suite/bugs/closed/bug_3294.v | 6 + test-suite/bugs/closed/bug_3297.v | 12 + test-suite/bugs/closed/bug_3298.v | 22 + test-suite/bugs/closed/bug_3300.v | 7 + test-suite/bugs/closed/bug_3305.v | 13 + test-suite/bugs/closed/bug_3306.v | 12 + test-suite/bugs/closed/bug_3310.v | 11 + test-suite/bugs/closed/bug_3314.v | 148 +++ test-suite/bugs/closed/bug_3315.v | 37 + test-suite/bugs/closed/bug_3317.v | 94 ++ test-suite/bugs/closed/bug_3319.v | 26 + test-suite/bugs/closed/bug_3320.v | 5 + test-suite/bugs/closed/bug_3321.v | 19 + test-suite/bugs/closed/bug_3322.v | 24 + test-suite/bugs/closed/bug_3323.v | 78 ++ test-suite/bugs/closed/bug_3324.v | 48 + test-suite/bugs/closed/bug_3325.v | 48 + test-suite/bugs/closed/bug_3326.v | 19 + test-suite/bugs/closed/bug_3329.v | 94 ++ test-suite/bugs/closed/bug_3330.v | 1115 ++++++++++++++++++ test-suite/bugs/closed/bug_3331.v | 31 + test-suite/bugs/closed/bug_3332.v | 6 + test-suite/bugs/closed/bug_3336.v | 9 + test-suite/bugs/closed/bug_3337.v | 4 + test-suite/bugs/closed/bug_3338.v | 4 + test-suite/bugs/closed/bug_3344.v | 59 + test-suite/bugs/closed/bug_3346.v | 4 + test-suite/bugs/closed/bug_3347.v | 40 + test-suite/bugs/closed/bug_3348.v | 6 + test-suite/bugs/closed/bug_3350.v | 121 ++ test-suite/bugs/closed/bug_3352.v | 35 + test-suite/bugs/closed/bug_3354.v | 12 + test-suite/bugs/closed/bug_3355.v | 6 + test-suite/bugs/closed/bug_3368.v | 16 + test-suite/bugs/closed/bug_3372.v | 7 + test-suite/bugs/closed/bug_3373.v | 34 + test-suite/bugs/closed/bug_3374.v | 52 + test-suite/bugs/closed/bug_3375.v | 49 + test-suite/bugs/closed/bug_3377.v | 18 + test-suite/bugs/closed/bug_3382.v | 64 ++ test-suite/bugs/closed/bug_3383.v | 6 + test-suite/bugs/closed/bug_3386.v | 17 + test-suite/bugs/closed/bug_3387.v | 22 + test-suite/bugs/closed/bug_3388.v | 57 + test-suite/bugs/closed/bug_3390.v | 9 + test-suite/bugs/closed/bug_3392.v | 40 + test-suite/bugs/closed/bug_3393.v | 153 +++ test-suite/bugs/closed/bug_3402.v | 7 + test-suite/bugs/closed/bug_3408.v | 163 +++ test-suite/bugs/closed/bug_3416.v | 12 + test-suite/bugs/closed/bug_3417.v | 7 + test-suite/bugs/closed/bug_3422.v | 209 ++++ test-suite/bugs/closed/bug_3427.v | 196 ++++ test-suite/bugs/closed/bug_3428.v | 35 + test-suite/bugs/closed/bug_3439.v | 44 + test-suite/bugs/closed/bug_3441.v | 23 + test-suite/bugs/closed/bug_3446.v | 51 + test-suite/bugs/closed/bug_3453.v | 10 + test-suite/bugs/closed/bug_3454.v | 63 ++ test-suite/bugs/closed/bug_3461.v | 5 + test-suite/bugs/closed/bug_3467.v | 6 + test-suite/bugs/closed/bug_3469.v | 29 + test-suite/bugs/closed/bug_3477.v | 9 + test-suite/bugs/closed/bug_3480.v | 48 + test-suite/bugs/closed/bug_3481.v | 67 ++ test-suite/bugs/closed/bug_3482.v | 11 + test-suite/bugs/closed/bug_3483.v | 4 + test-suite/bugs/closed/bug_3484.v | 31 + test-suite/bugs/closed/bug_3485.v | 133 +++ test-suite/bugs/closed/bug_3487.v | 8 + test-suite/bugs/closed/bug_3490.v | 27 + test-suite/bugs/closed/bug_3491.v | 4 + test-suite/bugs/closed/bug_3495.v | 18 + test-suite/bugs/closed/bug_3505.v | 44 + test-suite/bugs/closed/bug_3509.v | 6 + test-suite/bugs/closed/bug_3510.v | 5 + test-suite/bugs/closed/bug_3513.v | 73 ++ test-suite/bugs/closed/bug_3520.v | 9 + test-suite/bugs/closed/bug_3531.v | 54 + test-suite/bugs/closed/bug_3537.v | 12 + test-suite/bugs/closed/bug_3539.v | 66 ++ test-suite/bugs/closed/bug_3542.v | 6 + test-suite/bugs/closed/bug_3546.v | 17 + test-suite/bugs/closed/bug_3554.v | 1 + test-suite/bugs/closed/bug_3559.v | 88 ++ test-suite/bugs/closed/bug_3560.v | 15 + test-suite/bugs/closed/bug_3561.v | 24 + test-suite/bugs/closed/bug_3562.v | 6 + test-suite/bugs/closed/bug_3563.v | 38 + test-suite/bugs/closed/bug_3566.v | 23 + test-suite/bugs/closed/bug_3567.v | 68 ++ test-suite/bugs/closed/bug_3584.v | 16 + test-suite/bugs/closed/bug_3590.v | 12 + test-suite/bugs/closed/bug_3593.v | 10 + test-suite/bugs/closed/bug_3594.v | 51 + test-suite/bugs/closed/bug_3596.v | 19 + test-suite/bugs/closed/bug_3612.v | 54 + test-suite/bugs/closed/bug_3616.v | 3 + test-suite/bugs/closed/bug_3618.v | 103 ++ test-suite/bugs/closed/bug_3623.v | 4 + test-suite/bugs/closed/bug_3624.v | 11 + test-suite/bugs/closed/bug_3625.v | 12 + test-suite/bugs/closed/bug_3628.v | 9 + test-suite/bugs/closed/bug_3633.v | 10 + test-suite/bugs/closed/bug_3637.v | 11 + test-suite/bugs/closed/bug_3638.v | 25 + test-suite/bugs/closed/bug_3640.v | 31 + test-suite/bugs/closed/bug_3641.v | 21 + test-suite/bugs/closed/bug_3647.v | 654 +++++++++++ test-suite/bugs/closed/bug_3648.v | 83 ++ test-suite/bugs/closed/bug_3649.v | 60 + test-suite/bugs/closed/bug_3652.v | 100 ++ test-suite/bugs/closed/bug_3653.v | 13 + test-suite/bugs/closed/bug_3654.v | 7 + test-suite/bugs/closed/bug_3656.v | 53 + test-suite/bugs/closed/bug_3657.v | 12 + test-suite/bugs/closed/bug_3658.v | 75 ++ test-suite/bugs/closed/bug_3660.v | 28 + test-suite/bugs/closed/bug_3661.v | 88 ++ test-suite/bugs/closed/bug_3662.v | 46 + test-suite/bugs/closed/bug_3664.v | 24 + test-suite/bugs/closed/bug_3665.v | 33 + test-suite/bugs/closed/bug_3666.v | 51 + test-suite/bugs/closed/bug_3667.v | 23 + test-suite/bugs/closed/bug_3668.v | 54 + test-suite/bugs/closed/bug_3670.v | 23 + test-suite/bugs/closed/bug_3672.v | 27 + test-suite/bugs/closed/bug_3675.v | 20 + test-suite/bugs/closed/bug_3681.v | 20 + test-suite/bugs/closed/bug_3682.v | 6 + test-suite/bugs/closed/bug_3684.v | 5 + test-suite/bugs/closed/bug_3685.v | 75 ++ test-suite/bugs/closed/bug_3686.v | 63 ++ test-suite/bugs/closed/bug_3690.v | 48 + test-suite/bugs/closed/bug_3692.v | 26 + test-suite/bugs/closed/bug_3698.v | 26 + test-suite/bugs/closed/bug_3699.v | 159 +++ test-suite/bugs/closed/bug_3700.v | 84 ++ test-suite/bugs/closed/bug_3703.v | 32 + test-suite/bugs/closed/bug_3709.v | 24 + test-suite/bugs/closed/bug_3710.v | 48 + test-suite/bugs/closed/bug_3723.v | 6 + test-suite/bugs/closed/bug_3732.v | 105 ++ test-suite/bugs/closed/bug_3735.v | 4 + test-suite/bugs/closed/bug_3736.v | 8 + test-suite/bugs/closed/bug_3743.v | 11 + test-suite/bugs/closed/bug_3746.v | 92 ++ test-suite/bugs/closed/bug_3753.v | 4 + test-suite/bugs/closed/bug_3755.v | 16 + test-suite/bugs/closed/bug_3777.v | 17 + test-suite/bugs/closed/bug_3779.v | 12 + test-suite/bugs/closed/bug_3782.v | 64 ++ test-suite/bugs/closed/bug_3783.v | 33 + test-suite/bugs/closed/bug_3786.v | 33 + test-suite/bugs/closed/bug_3788.v | 6 + test-suite/bugs/closed/bug_3792.v | 4 + test-suite/bugs/closed/bug_3798.v | 12 + test-suite/bugs/closed/bug_3804.v | 12 + test-suite/bugs/closed/bug_3807.v | 33 + test-suite/bugs/closed/bug_3808.v | 3 + test-suite/bugs/closed/bug_3815.v | 9 + test-suite/bugs/closed/bug_3819.v | 9 + test-suite/bugs/closed/bug_3821.v | 2 + test-suite/bugs/closed/bug_3825.v | 23 + test-suite/bugs/closed/bug_3828.v | 2 + test-suite/bugs/closed/bug_3848.v | 22 + test-suite/bugs/closed/bug_3849.v | 8 + test-suite/bugs/closed/bug_3854.v | 22 + test-suite/bugs/closed/bug_3881.v | 34 + test-suite/bugs/closed/bug_3886.v | 23 + test-suite/bugs/closed/bug_3892.v | 8 + test-suite/bugs/closed/bug_3895.v | 22 + test-suite/bugs/closed/bug_3896.v | 4 + test-suite/bugs/closed/bug_3899.v | 11 + test-suite/bugs/closed/bug_3900.v | 13 + test-suite/bugs/closed/bug_3911.v | 26 + test-suite/bugs/closed/bug_3916.v | 2 + test-suite/bugs/closed/bug_3920.v | 7 + test-suite/bugs/closed/bug_3922.v | 85 ++ test-suite/bugs/closed/bug_3923.v | 36 + test-suite/bugs/closed/bug_3929.v | 67 ++ test-suite/bugs/closed/bug_3938.v | 8 + test-suite/bugs/closed/bug_3943.v | 50 + test-suite/bugs/closed/bug_3944.v | 5 + test-suite/bugs/closed/bug_3948.v | 24 + test-suite/bugs/closed/bug_3953.v | 5 + test-suite/bugs/closed/bug_3956.v | 143 +++ test-suite/bugs/closed/bug_3957.v | 6 + test-suite/bugs/closed/bug_3960.v | 26 + test-suite/bugs/closed/bug_3974.v | 7 + test-suite/bugs/closed/bug_3975.v | 8 + test-suite/bugs/closed/bug_3978.v | 27 + test-suite/bugs/closed/bug_3993.v | 3 + test-suite/bugs/closed/bug_3998.v | 24 + test-suite/bugs/closed/bug_4001.v | 18 + test-suite/bugs/closed/bug_4012.v | 5 + test-suite/bugs/closed/bug_4016.v | 11 + test-suite/bugs/closed/bug_4017.v | 8 + test-suite/bugs/closed/bug_4018.v | 3 + test-suite/bugs/closed/bug_4031.v | 14 + test-suite/bugs/closed/bug_4034.v | 25 + test-suite/bugs/closed/bug_4035.v | 13 + test-suite/bugs/closed/bug_4046.v | 6 + test-suite/bugs/closed/bug_4057.v | 210 ++++ test-suite/bugs/closed/bug_4069.v | 106 ++ test-suite/bugs/closed/bug_4078.v | 14 + test-suite/bugs/closed/bug_4089.v | 375 +++++++ test-suite/bugs/closed/bug_4095.v | 87 ++ test-suite/bugs/closed/bug_4097.v | 65 ++ test-suite/bugs/closed/bug_4101.v | 19 + test-suite/bugs/closed/bug_4103.v | 12 + test-suite/bugs/closed/bug_4116.v | 383 +++++++ test-suite/bugs/closed/bug_4120.v | 5 + test-suite/bugs/closed/bug_4121.v | 18 + test-suite/bugs/closed/bug_4132.v | 31 + test-suite/bugs/closed/bug_4149.v | 4 + test-suite/bugs/closed/bug_4151.v | 403 +++++++ test-suite/bugs/closed/bug_4161.v | 27 + test-suite/bugs/closed/bug_4165.v | 7 + test-suite/bugs/closed/bug_4187.v | 709 ++++++++++++ test-suite/bugs/closed/bug_4190.v | 15 + test-suite/bugs/closed/bug_4191.v | 5 + test-suite/bugs/closed/bug_4193.v | 7 + test-suite/bugs/closed/bug_4198.v | 39 + test-suite/bugs/closed/bug_4202.v | 10 + test-suite/bugs/closed/bug_4203.v | 19 + test-suite/bugs/closed/bug_4205.v | 8 + test-suite/bugs/closed/bug_4214.v | 6 + test-suite/bugs/closed/bug_4216.v | 19 + test-suite/bugs/closed/bug_4217.v | 6 + test-suite/bugs/closed/bug_4221.v | 9 + test-suite/bugs/closed/bug_4232.v | 20 + test-suite/bugs/closed/bug_4234.v | 7 + test-suite/bugs/closed/bug_4240.v | 12 + test-suite/bugs/closed/bug_4250.v | 11 + test-suite/bugs/closed/bug_4251.v | 17 + test-suite/bugs/closed/bug_4254.v | 13 + test-suite/bugs/closed/bug_4256.v | 43 + test-suite/bugs/closed/bug_4272.v | 12 + test-suite/bugs/closed/bug_4273.v | 9 + test-suite/bugs/closed/bug_4276.v | 11 + test-suite/bugs/closed/bug_4280.v | 24 + test-suite/bugs/closed/bug_4283.v | 7 + test-suite/bugs/closed/bug_4284.v | 6 + test-suite/bugs/closed/bug_4287.v | 123 ++ test-suite/bugs/closed/bug_4292.v | 7 + test-suite/bugs/closed/bug_4293.v | 7 + test-suite/bugs/closed/bug_4294.v | 31 + test-suite/bugs/closed/bug_4298.v | 7 + test-suite/bugs/closed/bug_4299.v | 12 + test-suite/bugs/closed/bug_4301.v | 13 + test-suite/bugs/closed/bug_4305.v | 17 + test-suite/bugs/closed/bug_4306.v | 32 + test-suite/bugs/closed/bug_4316.v | 3 + test-suite/bugs/closed/bug_4318.v | 2 + test-suite/bugs/closed/bug_4325.v | 5 + test-suite/bugs/closed/bug_4328.v | 6 + test-suite/bugs/closed/bug_4346.v | 2 + test-suite/bugs/closed/bug_4347.v | 17 + test-suite/bugs/closed/bug_4354.v | 11 + test-suite/bugs/closed/bug_4363.v | 9 + test-suite/bugs/closed/bug_4366.v | 15 + test-suite/bugs/closed/bug_4372.v | 20 + test-suite/bugs/closed/bug_4375.v | 106 ++ test-suite/bugs/closed/bug_4378.v | 9 + test-suite/bugs/closed/bug_4390.v | 37 + test-suite/bugs/closed/bug_4397.v | 3 + test-suite/bugs/closed/bug_4403.v | 3 + test-suite/bugs/closed/bug_4404.v | 3 + test-suite/bugs/closed/bug_4412.v | 4 + test-suite/bugs/closed/bug_4416.v | 4 + test-suite/bugs/closed/bug_4420.v | 18 + test-suite/bugs/closed/bug_4429.v | 31 + test-suite/bugs/closed/bug_4433.v | 29 + test-suite/bugs/closed/bug_4443.v | 31 + test-suite/bugs/closed/bug_4450.v | 58 + test-suite/bugs/closed/bug_4453.v | 8 + test-suite/bugs/closed/bug_4456.v | 647 +++++++++++ test-suite/bugs/closed/bug_4462.v | 7 + test-suite/bugs/closed/bug_4464.v | 4 + test-suite/bugs/closed/bug_4467.v | 15 + test-suite/bugs/closed/bug_4471.v | 6 + test-suite/bugs/closed/bug_4479.v | 3 + test-suite/bugs/closed/bug_4480.v | 11 + test-suite/bugs/closed/bug_4484.v | 10 + test-suite/bugs/closed/bug_4495.v | 1 + test-suite/bugs/closed/bug_4498.v | 24 + test-suite/bugs/closed/bug_4503.v | 37 + test-suite/bugs/closed/bug_4511.v | 2 + test-suite/bugs/closed/bug_4519.v | 21 + test-suite/bugs/closed/bug_4527.v | 270 +++++ test-suite/bugs/closed/bug_4529.v | 44 + test-suite/bugs/closed/bug_4533.v | 230 ++++ test-suite/bugs/closed/bug_4538.v | 1 + test-suite/bugs/closed/bug_4544.v | 1009 +++++++++++++++++ test-suite/bugs/closed/bug_4574.v | 7 + test-suite/bugs/closed/bug_4576.v | 3 + test-suite/bugs/closed/bug_4580.v | 6 + test-suite/bugs/closed/bug_4582.v | 10 + test-suite/bugs/closed/bug_4588.v | 10 + test-suite/bugs/closed/bug_4596.v | 14 + test-suite/bugs/closed/bug_4603.v | 10 + test-suite/bugs/closed/bug_4612.v | 7 + test-suite/bugs/closed/bug_4616.v | 7 + test-suite/bugs/closed/bug_4622.v | 24 + test-suite/bugs/closed/bug_4623.v | 5 + test-suite/bugs/closed/bug_4624.v | 7 + test-suite/bugs/closed/bug_4627.v | 49 + test-suite/bugs/closed/bug_4628.v | 46 + test-suite/bugs/closed/bug_4634.v | 16 + test-suite/bugs/closed/bug_4644.v | 52 + test-suite/bugs/closed/bug_4653.v | 3 + test-suite/bugs/closed/bug_4661.v | 10 + test-suite/bugs/closed/bug_4663.v | 3 + test-suite/bugs/closed/bug_4670.v | 7 + test-suite/bugs/closed/bug_4673.v | 57 + test-suite/bugs/closed/bug_4679.v | 18 + test-suite/bugs/closed/bug_4684.v | 32 + test-suite/bugs/closed/bug_4695.v | 38 + test-suite/bugs/closed/bug_4708.v | 8 + test-suite/bugs/closed/bug_4709.v | 18 + test-suite/bugs/closed/bug_4710.v | 15 + test-suite/bugs/closed/bug_4713.v | 10 + test-suite/bugs/closed/bug_4717.v | 33 + test-suite/bugs/closed/bug_4718.v | 15 + test-suite/bugs/closed/bug_4720.v | 50 + test-suite/bugs/closed/bug_4723.v | 28 + test-suite/bugs/closed/bug_4725.v | 38 + test-suite/bugs/closed/bug_4726.v | 19 + test-suite/bugs/closed/bug_4737.v | 9 + test-suite/bugs/closed/bug_4745.v | 35 + test-suite/bugs/closed/bug_4746.v | 14 + test-suite/bugs/closed/bug_4754.v | 35 + test-suite/bugs/closed/bug_4762.v | 23 + test-suite/bugs/closed/bug_4763.v | 13 + test-suite/bugs/closed/bug_4764.v | 5 + test-suite/bugs/closed/bug_4769.v | 94 ++ test-suite/bugs/closed/bug_4772.v | 6 + test-suite/bugs/closed/bug_4780.v | 105 ++ test-suite/bugs/closed/bug_4782.v | 25 + test-suite/bugs/closed/bug_4785.v | 34 + test-suite/bugs/closed/bug_4787.v | 7 + test-suite/bugs/closed/bug_4798.v | 3 + test-suite/bugs/closed/bug_4811.v | 1685 ++++++++++++++++++++++++++++ test-suite/bugs/closed/bug_4813.v | 9 + test-suite/bugs/closed/bug_4816.v | 29 + test-suite/bugs/closed/bug_4818.v | 24 + test-suite/bugs/closed/bug_4844.v | 47 + test-suite/bugs/closed/bug_4852.v | 53 + test-suite/bugs/closed/bug_4858.v | 7 + test-suite/bugs/closed/bug_4859.v | 7 + test-suite/bugs/closed/bug_4863.v | 33 + test-suite/bugs/closed/bug_4865.v | 52 + test-suite/bugs/closed/bug_4869.v | 18 + test-suite/bugs/closed/bug_4873.v | 71 ++ test-suite/bugs/closed/bug_4877.v | 12 + test-suite/bugs/closed/bug_4880.v | 11 + test-suite/bugs/closed/bug_4893.v | 4 + test-suite/bugs/closed/bug_4904.v | 11 + test-suite/bugs/closed/bug_4932.v | 44 + test-suite/bugs/closed/bug_4955.v | 98 ++ test-suite/bugs/closed/bug_4957.v | 6 + test-suite/bugs/closed/bug_4966.v | 10 + test-suite/bugs/closed/bug_4969.v | 11 + test-suite/bugs/closed/bug_4970.v | 3 + test-suite/bugs/closed/bug_5011.v | 2 + test-suite/bugs/closed/bug_5012.v | 17 + test-suite/bugs/closed/bug_5019.v | 5 + test-suite/bugs/closed/bug_5036.v | 10 + test-suite/bugs/closed/bug_5043.v | 8 + test-suite/bugs/closed/bug_5045.v | 3 + test-suite/bugs/closed/bug_5065.v | 6 + test-suite/bugs/closed/bug_5066.v | 7 + test-suite/bugs/closed/bug_5077.v | 8 + test-suite/bugs/closed/bug_5078.v | 5 + test-suite/bugs/closed/bug_5093.v | 11 + test-suite/bugs/closed/bug_5095.v | 5 + test-suite/bugs/closed/bug_5096.v | 219 ++++ test-suite/bugs/closed/bug_5097.v | 7 + test-suite/bugs/closed/bug_5123.v | 33 + test-suite/bugs/closed/bug_5127.v | 15 + test-suite/bugs/closed/bug_5145.v | 10 + test-suite/bugs/closed/bug_5149.v | 46 + test-suite/bugs/closed/bug_5153.v | 8 + test-suite/bugs/closed/bug_5161.v | 27 + test-suite/bugs/closed/bug_5177.v | 22 + test-suite/bugs/closed/bug_5180.v | 64 ++ test-suite/bugs/closed/bug_5181.v | 2 + test-suite/bugs/closed/bug_5188.v | 5 + test-suite/bugs/closed/bug_5193.v | 14 + test-suite/bugs/closed/bug_5198.v | 39 + test-suite/bugs/closed/bug_5203.v | 4 + test-suite/bugs/closed/bug_5205.v | 6 + test-suite/bugs/closed/bug_5208.v | 222 ++++ test-suite/bugs/closed/bug_5215.v | 286 +++++ test-suite/bugs/closed/bug_5215_2.v | 8 + test-suite/bugs/closed/bug_5219.v | 10 + test-suite/bugs/closed/bug_5233.v | 2 + test-suite/bugs/closed/bug_5245.v | 18 + test-suite/bugs/closed/bug_5255.v | 24 + test-suite/bugs/closed/bug_5277.v | 11 + test-suite/bugs/closed/bug_5281.v | 6 + test-suite/bugs/closed/bug_5286.v | 9 + test-suite/bugs/closed/bug_5300.v | 39 + test-suite/bugs/closed/bug_5315.v | 10 + test-suite/bugs/closed/bug_5321.v | 18 + test-suite/bugs/closed/bug_5322.v | 14 + test-suite/bugs/closed/bug_5323.v | 26 + test-suite/bugs/closed/bug_5331.v | 10 + test-suite/bugs/closed/bug_5345.v | 7 + test-suite/bugs/closed/bug_5346.v | 29 + test-suite/bugs/closed/bug_5347.v | 10 + test-suite/bugs/closed/bug_5359.v | 218 ++++ test-suite/bugs/closed/bug_5365.v | 13 + test-suite/bugs/closed/bug_5368.v | 6 + test-suite/bugs/closed/bug_5372.v | 8 + test-suite/bugs/closed/bug_5377.v | 54 + test-suite/bugs/closed/bug_5401.v | 21 + test-suite/bugs/closed/bug_5414.v | 12 + test-suite/bugs/closed/bug_5434.v | 18 + test-suite/bugs/closed/bug_5435.v | 1 + test-suite/bugs/closed/bug_5449.v | 6 + test-suite/bugs/closed/bug_5460.v | 11 + test-suite/bugs/closed/bug_5470.v | 3 + test-suite/bugs/closed/bug_5476.v | 28 + test-suite/bugs/closed/bug_5486.v | 15 + test-suite/bugs/closed/bug_5487.v | 9 + test-suite/bugs/closed/bug_5500.v | 35 + test-suite/bugs/closed/bug_5501.v | 21 + test-suite/bugs/closed/bug_5522.v | 7 + test-suite/bugs/closed/bug_5523.v | 6 + test-suite/bugs/closed/bug_5526.v | 3 + test-suite/bugs/closed/bug_5532.v | 15 + test-suite/bugs/closed/bug_5539.v | 15 + test-suite/bugs/closed/bug_5547.v | 16 + test-suite/bugs/closed/bug_5550.v | 10 + test-suite/bugs/closed/bug_5578.v | 57 + test-suite/bugs/closed/bug_5598.v | 8 + test-suite/bugs/closed/bug_5608.v | 33 + test-suite/bugs/closed/bug_5618.v | 9 + test-suite/bugs/closed/bug_5641.v | 6 + test-suite/bugs/closed/bug_5666.v | 4 + test-suite/bugs/closed/bug_5671.v | 7 + test-suite/bugs/closed/bug_5683.v | 71 ++ test-suite/bugs/closed/bug_5692.v | 88 ++ test-suite/bugs/closed/bug_5696.v | 5 + test-suite/bugs/closed/bug_5697.v | 19 + test-suite/bugs/closed/bug_5707.v | 12 + test-suite/bugs/closed/bug_5713.v | 15 + test-suite/bugs/closed/bug_5717.v | 5 + test-suite/bugs/closed/bug_5719.v | 9 + test-suite/bugs/closed/bug_5726.v | 34 + test-suite/bugs/closed/bug_5741.v | 4 + test-suite/bugs/closed/bug_5749.v | 18 + test-suite/bugs/closed/bug_5750.v | 3 + test-suite/bugs/closed/bug_5755.v | 16 + test-suite/bugs/closed/bug_5757.v | 76 ++ test-suite/bugs/closed/bug_5761.v | 126 +++ test-suite/bugs/closed/bug_5762.v | 34 + test-suite/bugs/closed/bug_5765.v | 3 + test-suite/bugs/closed/bug_5769.v | 20 + test-suite/bugs/closed/bug_5786.v | 26 + test-suite/bugs/closed/bug_5790.v | 7 + test-suite/bugs/closed/bug_5797.v | 212 ++++ test-suite/bugs/closed/bug_5845.v | 7 + test-suite/bugs/closed/bug_5940.v | 11 + test-suite/bugs/closed/bug_6070.v | 32 + test-suite/bugs/closed/bug_6129.v | 9 + test-suite/bugs/closed/bug_6191.v | 16 + test-suite/bugs/closed/bug_6297.v | 8 + test-suite/bugs/closed/bug_6313.v | 64 ++ test-suite/bugs/closed/bug_6323.v | 9 + test-suite/bugs/closed/bug_6378.v | 18 + test-suite/bugs/closed/bug_6490.v | 4 + test-suite/bugs/closed/bug_6529.v | 16 + test-suite/bugs/closed/bug_6534.v | 7 + test-suite/bugs/closed/bug_6617.v | 34 + test-suite/bugs/closed/bug_6631.v | 7 + test-suite/bugs/closed/bug_6634.v | 6 + test-suite/bugs/closed/bug_6661.v | 259 +++++ test-suite/bugs/closed/bug_6677.v | 5 + test-suite/bugs/closed/bug_6770.v | 7 + test-suite/bugs/closed/bug_6774.v | 7 + test-suite/bugs/closed/bug_6775.v | 43 + test-suite/bugs/closed/bug_6878.v | 8 + test-suite/bugs/closed/bug_6910.v | 5 + test-suite/bugs/closed/bug_6951.v | 2 + test-suite/bugs/closed/bug_6956.v | 13 + test-suite/bugs/closed/bug_7011.v | 16 + test-suite/bugs/closed/bug_7068.v | 6 + test-suite/bugs/closed/bug_7076.v | 4 + test-suite/bugs/closed/bug_7092.v | 70 ++ test-suite/bugs/closed/bug_7113.v | 10 + test-suite/bugs/closed/bug_7195.v | 12 + test-suite/bugs/closed/bug_7333.v | 39 + test-suite/bugs/closed/bug_7392.v | 9 + test-suite/bugs/closed/bug_7421.v | 39 + test-suite/bugs/closed/bug_7462.v | 13 + test-suite/bugs/closed/bug_7554.v | 12 + test-suite/bugs/closed/bug_7615.v | 19 + test-suite/bugs/closed/bug_7631.v | 21 + test-suite/bugs/closed/bug_7695.v | 20 + test-suite/bugs/closed/bug_7700.v | 9 + test-suite/bugs/closed/bug_7712.v | 4 + test-suite/bugs/closed/bug_7723.v | 58 + test-suite/bugs/closed/bug_7754.v | 21 + test-suite/bugs/closed/bug_7779.v | 15 + test-suite/bugs/closed/bug_7780.v | 16 + test-suite/bugs/closed/bug_7795.v | 65 ++ test-suite/bugs/closed/bug_7811.v | 114 ++ test-suite/bugs/closed/bug_7854.v | 10 + test-suite/bugs/closed/bug_7867.v | 4 + test-suite/bugs/closed/bug_7900.v | 53 + test-suite/bugs/closed/bug_7903.v | 4 + test-suite/bugs/closed/bug_7967.v | 2 + test-suite/bugs/closed/bug_8004.v | 47 + test-suite/bugs/closed/bug_8081.v | 4 + test-suite/bugs/closed/bug_808_2411.v | 27 + test-suite/bugs/closed/bug_8106.v | 4 + test-suite/bugs/closed/bug_8119.v | 46 + test-suite/bugs/closed/bug_8121.v | 46 + test-suite/bugs/closed/bug_8126.v | 13 + test-suite/bugs/closed/bug_8215.v | 14 + test-suite/bugs/closed/bug_8270.v | 15 + test-suite/bugs/closed/bug_8288.v | 7 + test-suite/bugs/closed/bug_8432.v | 39 + test-suite/bugs/closed/bug_8478.v | 11 + test-suite/bugs/closed/bug_8532.v | 8 + test-suite/bugs/opened/1338.v-disabled | 12 - test-suite/bugs/opened/1596.v | 260 ----- test-suite/bugs/opened/1615.v | 12 - test-suite/bugs/opened/1671.v | 12 - test-suite/bugs/opened/1811.v | 10 - test-suite/bugs/opened/2572.v-disabled | 187 --- test-suite/bugs/opened/3010.v-disabled | 1 - test-suite/bugs/opened/3092.v | 9 - test-suite/bugs/opened/3166.v | 83 -- test-suite/bugs/opened/3186.v-disabled | 4 - test-suite/bugs/opened/3248.v | 17 - test-suite/bugs/opened/3277.v | 7 - test-suite/bugs/opened/3278.v | 25 - test-suite/bugs/opened/3283.v | 28 - test-suite/bugs/opened/3295.v | 104 -- test-suite/bugs/opened/3304.v | 3 - test-suite/bugs/opened/3311.v | 10 - test-suite/bugs/opened/3312.v | 5 - test-suite/bugs/opened/3343.v | 46 - test-suite/bugs/opened/3345.v | 145 --- test-suite/bugs/opened/3357.v | 9 - test-suite/bugs/opened/3363.v | 26 - test-suite/bugs/opened/3370.v | 12 - test-suite/bugs/opened/3395.v | 231 ---- test-suite/bugs/opened/3424.v | 24 - test-suite/bugs/opened/3459.v | 31 - test-suite/bugs/opened/3463.v | 13 - test-suite/bugs/opened/3478.v-disabled | 8 - test-suite/bugs/opened/3626.v | 7 - test-suite/bugs/opened/3655.v | 9 - test-suite/bugs/opened/3754.v | 284 ----- test-suite/bugs/opened/3794.v | 7 - test-suite/bugs/opened/3889.v | 11 - test-suite/bugs/opened/3890.v | 18 - test-suite/bugs/opened/3919.v-disabled | 13 - test-suite/bugs/opened/3922.v-disabled | 83 -- test-suite/bugs/opened/3928.v-disabled | 12 - test-suite/bugs/opened/3938.v | 6 - test-suite/bugs/opened/3946.v | 11 - test-suite/bugs/opened/4701.v | 23 - test-suite/bugs/opened/4721.v | 13 - test-suite/bugs/opened/4728.v | 72 -- test-suite/bugs/opened/4755.v | 34 - test-suite/bugs/opened/4771.v | 22 - test-suite/bugs/opened/4778.v | 35 - test-suite/bugs/opened/4781.v | 94 -- test-suite/bugs/opened/4813.v | 5 - test-suite/bugs/opened/6393.v | 11 - test-suite/bugs/opened/6602.v | 17 - test-suite/bugs/opened/bug_1338.v-disabled | 12 + test-suite/bugs/opened/bug_1596.v | 260 +++++ test-suite/bugs/opened/bug_1615.v | 11 + test-suite/bugs/opened/bug_1671.v | 12 + test-suite/bugs/opened/bug_1811.v | 10 + test-suite/bugs/opened/bug_2572.v-disabled | 187 +++ test-suite/bugs/opened/bug_3010.v-disabled | 1 + test-suite/bugs/opened/bug_3092.v | 9 + test-suite/bugs/opened/bug_3166.v | 83 ++ test-suite/bugs/opened/bug_3186.v-disabled | 4 + test-suite/bugs/opened/bug_3248.v | 17 + test-suite/bugs/opened/bug_3277.v | 7 + test-suite/bugs/opened/bug_3278.v | 25 + test-suite/bugs/opened/bug_3283.v | 28 + test-suite/bugs/opened/bug_3295.v | 104 ++ test-suite/bugs/opened/bug_3304.v | 3 + test-suite/bugs/opened/bug_3311.v | 10 + test-suite/bugs/opened/bug_3312.v | 5 + test-suite/bugs/opened/bug_3343.v | 46 + test-suite/bugs/opened/bug_3345.v | 145 +++ test-suite/bugs/opened/bug_3357.v | 9 + test-suite/bugs/opened/bug_3363.v | 26 + test-suite/bugs/opened/bug_3370.v | 12 + test-suite/bugs/opened/bug_3395.v | 231 ++++ test-suite/bugs/opened/bug_3424.v | 24 + test-suite/bugs/opened/bug_3459.v | 31 + test-suite/bugs/opened/bug_3463.v | 12 + test-suite/bugs/opened/bug_3478.v-disabled | 8 + test-suite/bugs/opened/bug_3626.v | 7 + test-suite/bugs/opened/bug_3655.v | 9 + test-suite/bugs/opened/bug_3754.v | 284 +++++ test-suite/bugs/opened/bug_3794.v | 7 + test-suite/bugs/opened/bug_3889.v | 11 + test-suite/bugs/opened/bug_3890.v | 18 + test-suite/bugs/opened/bug_3919.v-disabled | 13 + test-suite/bugs/opened/bug_3922.v-disabled | 83 ++ test-suite/bugs/opened/bug_3928.v-disabled | 12 + test-suite/bugs/opened/bug_3938.v | 6 + test-suite/bugs/opened/bug_3946.v | 11 + test-suite/bugs/opened/bug_4701.v | 23 + test-suite/bugs/opened/bug_4721.v | 13 + test-suite/bugs/opened/bug_4728.v | 72 ++ test-suite/bugs/opened/bug_4755.v | 34 + test-suite/bugs/opened/bug_4771.v | 22 + test-suite/bugs/opened/bug_4778.v | 35 + test-suite/bugs/opened/bug_4781.v | 94 ++ test-suite/bugs/opened/bug_4813.v | 5 + test-suite/bugs/opened/bug_6393.v | 11 + test-suite/bugs/opened/bug_6602.v | 17 + test-suite/interactive/4289.v | 14 - test-suite/interactive/bug_4289.v | 14 + 1655 files changed, 31117 insertions(+), 31207 deletions(-) delete mode 100644 test-suite/bugs/5996.v create mode 100644 test-suite/bugs/bug_5996.v delete mode 100644 test-suite/bugs/closed/1238.v delete mode 100644 test-suite/bugs/closed/1243.v delete mode 100644 test-suite/bugs/closed/1302.v delete mode 100644 test-suite/bugs/closed/1322.v delete mode 100644 test-suite/bugs/closed/1341.v delete mode 100644 test-suite/bugs/closed/1362.v delete mode 100644 test-suite/bugs/closed/1411.v delete mode 100644 test-suite/bugs/closed/1414.v delete mode 100644 test-suite/bugs/closed/1416.v delete mode 100644 test-suite/bugs/closed/1419.v delete mode 100644 test-suite/bugs/closed/1425.v delete mode 100644 test-suite/bugs/closed/1446.v delete mode 100644 test-suite/bugs/closed/1448.v delete mode 100644 test-suite/bugs/closed/1477.v delete mode 100644 test-suite/bugs/closed/1483.v delete mode 100644 test-suite/bugs/closed/1501.v delete mode 100644 test-suite/bugs/closed/1507.v delete mode 100644 test-suite/bugs/closed/1519.v delete mode 100644 test-suite/bugs/closed/1542.v delete mode 100644 test-suite/bugs/closed/1543.v delete mode 100644 test-suite/bugs/closed/1545.v delete mode 100644 test-suite/bugs/closed/1547.v delete mode 100644 test-suite/bugs/closed/1551.v delete mode 100644 test-suite/bugs/closed/1568.v delete mode 100644 test-suite/bugs/closed/1576.v delete mode 100644 test-suite/bugs/closed/1582.v delete mode 100644 test-suite/bugs/closed/1584.v delete mode 100644 test-suite/bugs/closed/1604.v delete mode 100644 test-suite/bugs/closed/1614.v delete mode 100644 test-suite/bugs/closed/1618.v delete mode 100644 test-suite/bugs/closed/1634.v delete mode 100644 test-suite/bugs/closed/1643.v delete mode 100644 test-suite/bugs/closed/1680.v delete mode 100644 test-suite/bugs/closed/1683.v delete mode 100644 test-suite/bugs/closed/1696.v delete mode 100644 test-suite/bugs/closed/1703.v delete mode 100644 test-suite/bugs/closed/1704.v delete mode 100644 test-suite/bugs/closed/1711.v delete mode 100644 test-suite/bugs/closed/1718.v delete mode 100644 test-suite/bugs/closed/1738.v delete mode 100644 test-suite/bugs/closed/1740.v delete mode 100644 test-suite/bugs/closed/1754.v delete mode 100644 test-suite/bugs/closed/1773.v delete mode 100644 test-suite/bugs/closed/1774.v delete mode 100644 test-suite/bugs/closed/1775.v delete mode 100644 test-suite/bugs/closed/1776.v delete mode 100644 test-suite/bugs/closed/1779.v delete mode 100644 test-suite/bugs/closed/1780.v delete mode 100644 test-suite/bugs/closed/1784.v delete mode 100644 test-suite/bugs/closed/1787.v delete mode 100644 test-suite/bugs/closed/1791.v delete mode 100644 test-suite/bugs/closed/1834.v delete mode 100644 test-suite/bugs/closed/1844.v delete mode 100644 test-suite/bugs/closed/1850.v delete mode 100644 test-suite/bugs/closed/1859.v delete mode 100644 test-suite/bugs/closed/1865.v delete mode 100644 test-suite/bugs/closed/1891.v delete mode 100644 test-suite/bugs/closed/1898.v delete mode 100644 test-suite/bugs/closed/1900.v delete mode 100644 test-suite/bugs/closed/1901.v delete mode 100644 test-suite/bugs/closed/1905.v delete mode 100644 test-suite/bugs/closed/1907.v delete mode 100644 test-suite/bugs/closed/1912.v delete mode 100644 test-suite/bugs/closed/1915.v delete mode 100644 test-suite/bugs/closed/1918.v delete mode 100644 test-suite/bugs/closed/1925.v delete mode 100644 test-suite/bugs/closed/1931.v delete mode 100644 test-suite/bugs/closed/1935.v delete mode 100644 test-suite/bugs/closed/1939.v delete mode 100644 test-suite/bugs/closed/1944.v delete mode 100644 test-suite/bugs/closed/1951.v delete mode 100644 test-suite/bugs/closed/1962.v delete mode 100644 test-suite/bugs/closed/1963.v delete mode 100644 test-suite/bugs/closed/1977.v delete mode 100644 test-suite/bugs/closed/1981.v delete mode 100644 test-suite/bugs/closed/2001.v delete mode 100644 test-suite/bugs/closed/2006.v delete mode 100644 test-suite/bugs/closed/2016.v delete mode 100644 test-suite/bugs/closed/2017.v delete mode 100644 test-suite/bugs/closed/2021.v delete mode 100644 test-suite/bugs/closed/2027.v delete mode 100644 test-suite/bugs/closed/2083.v delete mode 100644 test-suite/bugs/closed/2089.v delete mode 100644 test-suite/bugs/closed/2095.v delete mode 100644 test-suite/bugs/closed/2105.v delete mode 100644 test-suite/bugs/closed/2108.v delete mode 100644 test-suite/bugs/closed/2117.v delete mode 100644 test-suite/bugs/closed/2123.v delete mode 100644 test-suite/bugs/closed/2127.v delete mode 100644 test-suite/bugs/closed/2135.v delete mode 100644 test-suite/bugs/closed/2136.v delete mode 100644 test-suite/bugs/closed/2137.v delete mode 100644 test-suite/bugs/closed/2139.v delete mode 100644 test-suite/bugs/closed/2141.v delete mode 100644 test-suite/bugs/closed/2145.v delete mode 100644 test-suite/bugs/closed/2149.v delete mode 100644 test-suite/bugs/closed/2164.v delete mode 100644 test-suite/bugs/closed/2181.v delete mode 100644 test-suite/bugs/closed/2193.v delete mode 100644 test-suite/bugs/closed/2230.v delete mode 100644 test-suite/bugs/closed/2231.v delete mode 100644 test-suite/bugs/closed/2243.v delete mode 100644 test-suite/bugs/closed/2244.v delete mode 100644 test-suite/bugs/closed/2245.v delete mode 100644 test-suite/bugs/closed/2250.v delete mode 100644 test-suite/bugs/closed/2251.v delete mode 100644 test-suite/bugs/closed/2255.v delete mode 100644 test-suite/bugs/closed/2262.v delete mode 100644 test-suite/bugs/closed/2281.v delete mode 100644 test-suite/bugs/closed/2295.v delete mode 100644 test-suite/bugs/closed/2299.v delete mode 100644 test-suite/bugs/closed/2300.v delete mode 100644 test-suite/bugs/closed/2303.v delete mode 100644 test-suite/bugs/closed/2304.v delete mode 100644 test-suite/bugs/closed/2307.v delete mode 100644 test-suite/bugs/closed/2310.v delete mode 100644 test-suite/bugs/closed/2319.v delete mode 100644 test-suite/bugs/closed/2320.v delete mode 100644 test-suite/bugs/closed/2342.v delete mode 100644 test-suite/bugs/closed/2347.v delete mode 100644 test-suite/bugs/closed/2350.v delete mode 100644 test-suite/bugs/closed/2353.v delete mode 100644 test-suite/bugs/closed/2360.v delete mode 100644 test-suite/bugs/closed/2362.v delete mode 100644 test-suite/bugs/closed/2375.v delete mode 100644 test-suite/bugs/closed/2378.v delete mode 100644 test-suite/bugs/closed/2388.v delete mode 100644 test-suite/bugs/closed/2393.v delete mode 100644 test-suite/bugs/closed/2404.v delete mode 100644 test-suite/bugs/closed/2406.v delete mode 100644 test-suite/bugs/closed/2417.v delete mode 100644 test-suite/bugs/closed/2428.v delete mode 100644 test-suite/bugs/closed/2447.v delete mode 100644 test-suite/bugs/closed/2456.v delete mode 100644 test-suite/bugs/closed/2464.v delete mode 100644 test-suite/bugs/closed/2467.v delete mode 100644 test-suite/bugs/closed/2473.v delete mode 100644 test-suite/bugs/closed/2584.v delete mode 100644 test-suite/bugs/closed/2586.v delete mode 100644 test-suite/bugs/closed/2590.v delete mode 100644 test-suite/bugs/closed/2602.v delete mode 100644 test-suite/bugs/closed/2603.v delete mode 100644 test-suite/bugs/closed/2608.v delete mode 100644 test-suite/bugs/closed/2613.v delete mode 100644 test-suite/bugs/closed/2615.v delete mode 100644 test-suite/bugs/closed/2616.v delete mode 100644 test-suite/bugs/closed/2629.v delete mode 100644 test-suite/bugs/closed/2667.v delete mode 100644 test-suite/bugs/closed/2668.v delete mode 100644 test-suite/bugs/closed/2670.v delete mode 100644 test-suite/bugs/closed/2680.v delete mode 100644 test-suite/bugs/closed/2713.v delete mode 100644 test-suite/bugs/closed/2729.v delete mode 100644 test-suite/bugs/closed/2732.v delete mode 100644 test-suite/bugs/closed/2733.v delete mode 100644 test-suite/bugs/closed/2734.v delete mode 100644 test-suite/bugs/closed/2750.v delete mode 100644 test-suite/bugs/closed/2775.v delete mode 100644 test-suite/bugs/closed/2800.v delete mode 100644 test-suite/bugs/closed/2810.v delete mode 100644 test-suite/bugs/closed/2814.v delete mode 100644 test-suite/bugs/closed/2817.v delete mode 100644 test-suite/bugs/closed/2818.v delete mode 100644 test-suite/bugs/closed/2828.v delete mode 100644 test-suite/bugs/closed/2830.v delete mode 100644 test-suite/bugs/closed/2834.v delete mode 100644 test-suite/bugs/closed/2836.v delete mode 100644 test-suite/bugs/closed/2837.v delete mode 100644 test-suite/bugs/closed/2839.v delete mode 100644 test-suite/bugs/closed/2846.v delete mode 100644 test-suite/bugs/closed/2848.v delete mode 100644 test-suite/bugs/closed/2854.v delete mode 100644 test-suite/bugs/closed/2876.v delete mode 100644 test-suite/bugs/closed/2881.v delete mode 100644 test-suite/bugs/closed/2883.v delete mode 100644 test-suite/bugs/closed/2900.v delete mode 100644 test-suite/bugs/closed/2920.v delete mode 100644 test-suite/bugs/closed/2923.v delete mode 100644 test-suite/bugs/closed/2928.v delete mode 100644 test-suite/bugs/closed/2930.v delete mode 100644 test-suite/bugs/closed/2945.v delete mode 100644 test-suite/bugs/closed/2946.v delete mode 100644 test-suite/bugs/closed/2951.v delete mode 100644 test-suite/bugs/closed/2955.v delete mode 100644 test-suite/bugs/closed/2966.v delete mode 100644 test-suite/bugs/closed/2969.v delete mode 100644 test-suite/bugs/closed/2981.v delete mode 100644 test-suite/bugs/closed/2983.v delete mode 100644 test-suite/bugs/closed/2990.v delete mode 100644 test-suite/bugs/closed/2994.v delete mode 100644 test-suite/bugs/closed/2995.v delete mode 100644 test-suite/bugs/closed/2996.v delete mode 100644 test-suite/bugs/closed/3000.v delete mode 100644 test-suite/bugs/closed/3001.v delete mode 100644 test-suite/bugs/closed/3003.v delete mode 100644 test-suite/bugs/closed/3004.v delete mode 100644 test-suite/bugs/closed/3008.v delete mode 100644 test-suite/bugs/closed/3010b.v delete mode 100644 test-suite/bugs/closed/3016.v delete mode 100644 test-suite/bugs/closed/3017.v delete mode 100644 test-suite/bugs/closed/3022.v delete mode 100644 test-suite/bugs/closed/3023.v delete mode 100644 test-suite/bugs/closed/3036.v delete mode 100644 test-suite/bugs/closed/3037.v delete mode 100644 test-suite/bugs/closed/3043.v delete mode 100644 test-suite/bugs/closed/3045.v delete mode 100644 test-suite/bugs/closed/3050.v delete mode 100644 test-suite/bugs/closed/3054.v delete mode 100644 test-suite/bugs/closed/3062.v delete mode 100644 test-suite/bugs/closed/3068.v delete mode 100644 test-suite/bugs/closed/3070.v delete mode 100644 test-suite/bugs/closed/3071.v delete mode 100644 test-suite/bugs/closed/3080.v delete mode 100644 test-suite/bugs/closed/3088.v delete mode 100644 test-suite/bugs/closed/3093.v delete mode 100644 test-suite/bugs/closed/3100.v delete mode 100644 test-suite/bugs/closed/3125.v delete mode 100644 test-suite/bugs/closed/3142.v delete mode 100644 test-suite/bugs/closed/3164.v delete mode 100644 test-suite/bugs/closed/3188.v delete mode 100644 test-suite/bugs/closed/3199.v delete mode 100644 test-suite/bugs/closed/3205.v delete mode 100644 test-suite/bugs/closed/3209.v delete mode 100644 test-suite/bugs/closed/3210.v delete mode 100644 test-suite/bugs/closed/3212.v delete mode 100644 test-suite/bugs/closed/3217.v delete mode 100644 test-suite/bugs/closed/3228.v delete mode 100644 test-suite/bugs/closed/3230.v delete mode 100644 test-suite/bugs/closed/3242.v delete mode 100644 test-suite/bugs/closed/3249.v delete mode 100644 test-suite/bugs/closed/3251.v delete mode 100644 test-suite/bugs/closed/3257.v delete mode 100644 test-suite/bugs/closed/3258.v delete mode 100644 test-suite/bugs/closed/3259.v delete mode 100644 test-suite/bugs/closed/3260.v delete mode 100644 test-suite/bugs/closed/3262.v delete mode 100644 test-suite/bugs/closed/3264.v delete mode 100644 test-suite/bugs/closed/3265.v delete mode 100644 test-suite/bugs/closed/3266.v delete mode 100644 test-suite/bugs/closed/3267.v delete mode 100644 test-suite/bugs/closed/3281.v delete mode 100644 test-suite/bugs/closed/3282.v delete mode 100644 test-suite/bugs/closed/3284.v delete mode 100644 test-suite/bugs/closed/3285.v delete mode 100644 test-suite/bugs/closed/3286.v delete mode 100644 test-suite/bugs/closed/3287.v delete mode 100644 test-suite/bugs/closed/3289.v delete mode 100644 test-suite/bugs/closed/3291.v delete mode 100644 test-suite/bugs/closed/3294.v delete mode 100644 test-suite/bugs/closed/3297.v delete mode 100644 test-suite/bugs/closed/3298.v delete mode 100644 test-suite/bugs/closed/3300.v delete mode 100644 test-suite/bugs/closed/3305.v delete mode 100644 test-suite/bugs/closed/3306.v delete mode 100644 test-suite/bugs/closed/3310.v delete mode 100644 test-suite/bugs/closed/3314.v delete mode 100644 test-suite/bugs/closed/3315.v delete mode 100644 test-suite/bugs/closed/3317.v delete mode 100644 test-suite/bugs/closed/3319.v delete mode 100644 test-suite/bugs/closed/3320.v delete mode 100644 test-suite/bugs/closed/3321.v delete mode 100644 test-suite/bugs/closed/3322.v delete mode 100644 test-suite/bugs/closed/3323.v delete mode 100644 test-suite/bugs/closed/3324.v delete mode 100644 test-suite/bugs/closed/3325.v delete mode 100644 test-suite/bugs/closed/3326.v delete mode 100644 test-suite/bugs/closed/3329.v delete mode 100644 test-suite/bugs/closed/3330.v delete mode 100644 test-suite/bugs/closed/3331.v delete mode 100644 test-suite/bugs/closed/3332.v delete mode 100644 test-suite/bugs/closed/3336.v delete mode 100644 test-suite/bugs/closed/3337.v delete mode 100644 test-suite/bugs/closed/3338.v delete mode 100644 test-suite/bugs/closed/3344.v delete mode 100644 test-suite/bugs/closed/3346.v delete mode 100644 test-suite/bugs/closed/3347.v delete mode 100644 test-suite/bugs/closed/3348.v delete mode 100644 test-suite/bugs/closed/3350.v delete mode 100644 test-suite/bugs/closed/3352.v delete mode 100644 test-suite/bugs/closed/3354.v delete mode 100644 test-suite/bugs/closed/3355.v delete mode 100644 test-suite/bugs/closed/3368.v delete mode 100644 test-suite/bugs/closed/3372.v delete mode 100644 test-suite/bugs/closed/3373.v delete mode 100644 test-suite/bugs/closed/3374.v delete mode 100644 test-suite/bugs/closed/3375.v delete mode 100644 test-suite/bugs/closed/3377.v delete mode 100644 test-suite/bugs/closed/3382.v delete mode 100644 test-suite/bugs/closed/3383.v delete mode 100644 test-suite/bugs/closed/3386.v delete mode 100644 test-suite/bugs/closed/3387.v delete mode 100644 test-suite/bugs/closed/3388.v delete mode 100644 test-suite/bugs/closed/3390.v delete mode 100644 test-suite/bugs/closed/3392.v delete mode 100644 test-suite/bugs/closed/3393.v delete mode 100644 test-suite/bugs/closed/3402.v delete mode 100644 test-suite/bugs/closed/3408.v delete mode 100644 test-suite/bugs/closed/3416.v delete mode 100644 test-suite/bugs/closed/3417.v delete mode 100644 test-suite/bugs/closed/3422.v delete mode 100644 test-suite/bugs/closed/3427.v delete mode 100644 test-suite/bugs/closed/3428.v delete mode 100644 test-suite/bugs/closed/3439.v delete mode 100644 test-suite/bugs/closed/3441.v delete mode 100644 test-suite/bugs/closed/3446.v delete mode 100644 test-suite/bugs/closed/3453.v delete mode 100644 test-suite/bugs/closed/3454.v delete mode 100644 test-suite/bugs/closed/3461.v delete mode 100644 test-suite/bugs/closed/3467.v delete mode 100644 test-suite/bugs/closed/3469.v delete mode 100644 test-suite/bugs/closed/3477.v delete mode 100644 test-suite/bugs/closed/3480.v delete mode 100644 test-suite/bugs/closed/3481.v delete mode 100644 test-suite/bugs/closed/3482.v delete mode 100644 test-suite/bugs/closed/3483.v delete mode 100644 test-suite/bugs/closed/3484.v delete mode 100644 test-suite/bugs/closed/3485.v delete mode 100644 test-suite/bugs/closed/3487.v delete mode 100644 test-suite/bugs/closed/3490.v delete mode 100644 test-suite/bugs/closed/3491.v delete mode 100644 test-suite/bugs/closed/3495.v delete mode 100644 test-suite/bugs/closed/3505.v delete mode 100644 test-suite/bugs/closed/3509.v delete mode 100644 test-suite/bugs/closed/3510.v delete mode 100644 test-suite/bugs/closed/3513.v delete mode 100644 test-suite/bugs/closed/3520.v delete mode 100644 test-suite/bugs/closed/3531.v delete mode 100644 test-suite/bugs/closed/3537.v delete mode 100644 test-suite/bugs/closed/3539.v delete mode 100644 test-suite/bugs/closed/3542.v delete mode 100644 test-suite/bugs/closed/3546.v delete mode 100644 test-suite/bugs/closed/3554.v delete mode 100644 test-suite/bugs/closed/3559.v delete mode 100644 test-suite/bugs/closed/3560.v delete mode 100644 test-suite/bugs/closed/3561.v delete mode 100644 test-suite/bugs/closed/3562.v delete mode 100644 test-suite/bugs/closed/3563.v delete mode 100644 test-suite/bugs/closed/3566.v delete mode 100644 test-suite/bugs/closed/3567.v delete mode 100644 test-suite/bugs/closed/3584.v delete mode 100644 test-suite/bugs/closed/3590.v delete mode 100644 test-suite/bugs/closed/3593.v delete mode 100644 test-suite/bugs/closed/3594.v delete mode 100644 test-suite/bugs/closed/3596.v delete mode 100644 test-suite/bugs/closed/3612.v delete mode 100644 test-suite/bugs/closed/3616.v delete mode 100644 test-suite/bugs/closed/3618.v delete mode 100644 test-suite/bugs/closed/3623.v delete mode 100644 test-suite/bugs/closed/3624.v delete mode 100644 test-suite/bugs/closed/3625.v delete mode 100644 test-suite/bugs/closed/3628.v delete mode 100644 test-suite/bugs/closed/3633.v delete mode 100644 test-suite/bugs/closed/3637.v delete mode 100644 test-suite/bugs/closed/3638.v delete mode 100644 test-suite/bugs/closed/3640.v delete mode 100644 test-suite/bugs/closed/3641.v delete mode 100644 test-suite/bugs/closed/3647.v delete mode 100644 test-suite/bugs/closed/3648.v delete mode 100644 test-suite/bugs/closed/3649.v delete mode 100644 test-suite/bugs/closed/3652.v delete mode 100644 test-suite/bugs/closed/3653.v delete mode 100644 test-suite/bugs/closed/3654.v delete mode 100644 test-suite/bugs/closed/3656.v delete mode 100644 test-suite/bugs/closed/3657.v delete mode 100644 test-suite/bugs/closed/3658.v delete mode 100644 test-suite/bugs/closed/3660.v delete mode 100644 test-suite/bugs/closed/3661.v delete mode 100644 test-suite/bugs/closed/3662.v delete mode 100644 test-suite/bugs/closed/3664.v delete mode 100644 test-suite/bugs/closed/3665.v delete mode 100644 test-suite/bugs/closed/3666.v delete mode 100644 test-suite/bugs/closed/3667.v delete mode 100644 test-suite/bugs/closed/3668.v delete mode 100644 test-suite/bugs/closed/3670.v delete mode 100644 test-suite/bugs/closed/3672.v delete mode 100644 test-suite/bugs/closed/3675.v delete mode 100644 test-suite/bugs/closed/3681.v delete mode 100644 test-suite/bugs/closed/3682.v delete mode 100644 test-suite/bugs/closed/3684.v delete mode 100644 test-suite/bugs/closed/3685.v delete mode 100644 test-suite/bugs/closed/3686.v delete mode 100644 test-suite/bugs/closed/3690.v delete mode 100644 test-suite/bugs/closed/3692.v delete mode 100644 test-suite/bugs/closed/3698.v delete mode 100644 test-suite/bugs/closed/3699.v delete mode 100644 test-suite/bugs/closed/3700.v delete mode 100644 test-suite/bugs/closed/3703.v delete mode 100644 test-suite/bugs/closed/3709.v delete mode 100644 test-suite/bugs/closed/3710.v delete mode 100644 test-suite/bugs/closed/3723.v delete mode 100644 test-suite/bugs/closed/3732.v delete mode 100644 test-suite/bugs/closed/3735.v delete mode 100644 test-suite/bugs/closed/3736.v delete mode 100644 test-suite/bugs/closed/3743.v delete mode 100644 test-suite/bugs/closed/3746.v delete mode 100644 test-suite/bugs/closed/3753.v delete mode 100644 test-suite/bugs/closed/3755.v delete mode 100644 test-suite/bugs/closed/3777.v delete mode 100644 test-suite/bugs/closed/3779.v delete mode 100644 test-suite/bugs/closed/3782.v delete mode 100644 test-suite/bugs/closed/3783.v delete mode 100644 test-suite/bugs/closed/3786.v delete mode 100644 test-suite/bugs/closed/3788.v delete mode 100644 test-suite/bugs/closed/3792.v delete mode 100644 test-suite/bugs/closed/3798.v delete mode 100644 test-suite/bugs/closed/3804.v delete mode 100644 test-suite/bugs/closed/3807.v delete mode 100644 test-suite/bugs/closed/3808.v delete mode 100644 test-suite/bugs/closed/3815.v delete mode 100644 test-suite/bugs/closed/3819.v delete mode 100644 test-suite/bugs/closed/3821.v delete mode 100644 test-suite/bugs/closed/3825.v delete mode 100644 test-suite/bugs/closed/3828.v delete mode 100644 test-suite/bugs/closed/3848.v delete mode 100644 test-suite/bugs/closed/3849.v delete mode 100644 test-suite/bugs/closed/3854.v delete mode 100644 test-suite/bugs/closed/3881.v delete mode 100644 test-suite/bugs/closed/3886.v delete mode 100644 test-suite/bugs/closed/3892.v delete mode 100644 test-suite/bugs/closed/3895.v delete mode 100644 test-suite/bugs/closed/3896.v delete mode 100644 test-suite/bugs/closed/3899.v delete mode 100644 test-suite/bugs/closed/3900.v delete mode 100644 test-suite/bugs/closed/3911.v delete mode 100644 test-suite/bugs/closed/3916.v delete mode 100644 test-suite/bugs/closed/3920.v delete mode 100644 test-suite/bugs/closed/3922.v delete mode 100644 test-suite/bugs/closed/3923.v delete mode 100644 test-suite/bugs/closed/3929.v delete mode 100644 test-suite/bugs/closed/3938.v delete mode 100644 test-suite/bugs/closed/3943.v delete mode 100644 test-suite/bugs/closed/3944.v delete mode 100644 test-suite/bugs/closed/3948.v delete mode 100644 test-suite/bugs/closed/3953.v delete mode 100644 test-suite/bugs/closed/3956.v delete mode 100644 test-suite/bugs/closed/3957.v delete mode 100644 test-suite/bugs/closed/3960.v delete mode 100644 test-suite/bugs/closed/3974.v delete mode 100644 test-suite/bugs/closed/3975.v delete mode 100644 test-suite/bugs/closed/3978.v delete mode 100644 test-suite/bugs/closed/3993.v delete mode 100644 test-suite/bugs/closed/3998.v delete mode 100644 test-suite/bugs/closed/4001.v delete mode 100644 test-suite/bugs/closed/4012.v delete mode 100644 test-suite/bugs/closed/4016.v delete mode 100644 test-suite/bugs/closed/4017.v delete mode 100644 test-suite/bugs/closed/4018.v delete mode 100644 test-suite/bugs/closed/4031.v delete mode 100644 test-suite/bugs/closed/4034.v delete mode 100644 test-suite/bugs/closed/4035.v delete mode 100644 test-suite/bugs/closed/4046.v delete mode 100644 test-suite/bugs/closed/4057.v delete mode 100644 test-suite/bugs/closed/4069.v delete mode 100644 test-suite/bugs/closed/4078.v delete mode 100644 test-suite/bugs/closed/4089.v delete mode 100644 test-suite/bugs/closed/4095.v delete mode 100644 test-suite/bugs/closed/4097.v delete mode 100644 test-suite/bugs/closed/4101.v delete mode 100644 test-suite/bugs/closed/4103.v delete mode 100644 test-suite/bugs/closed/4116.v delete mode 100644 test-suite/bugs/closed/4120.v delete mode 100644 test-suite/bugs/closed/4121.v delete mode 100644 test-suite/bugs/closed/4132.v delete mode 100644 test-suite/bugs/closed/4149.v delete mode 100644 test-suite/bugs/closed/4151.v delete mode 100644 test-suite/bugs/closed/4161.v delete mode 100644 test-suite/bugs/closed/4165.v delete mode 100644 test-suite/bugs/closed/4187.v delete mode 100644 test-suite/bugs/closed/4190.v delete mode 100644 test-suite/bugs/closed/4191.v delete mode 100644 test-suite/bugs/closed/4193.v delete mode 100644 test-suite/bugs/closed/4198.v delete mode 100644 test-suite/bugs/closed/4202.v delete mode 100644 test-suite/bugs/closed/4203.v delete mode 100644 test-suite/bugs/closed/4205.v delete mode 100644 test-suite/bugs/closed/4214.v delete mode 100644 test-suite/bugs/closed/4216.v delete mode 100644 test-suite/bugs/closed/4217.v delete mode 100644 test-suite/bugs/closed/4221.v delete mode 100644 test-suite/bugs/closed/4232.v delete mode 100644 test-suite/bugs/closed/4234.v delete mode 100644 test-suite/bugs/closed/4240.v delete mode 100644 test-suite/bugs/closed/4250.v delete mode 100644 test-suite/bugs/closed/4251.v delete mode 100644 test-suite/bugs/closed/4254.v delete mode 100644 test-suite/bugs/closed/4256.v delete mode 100644 test-suite/bugs/closed/4272.v delete mode 100644 test-suite/bugs/closed/4273.v delete mode 100644 test-suite/bugs/closed/4276.v delete mode 100644 test-suite/bugs/closed/4280.v delete mode 100644 test-suite/bugs/closed/4283.v delete mode 100644 test-suite/bugs/closed/4284.v delete mode 100644 test-suite/bugs/closed/4287.v delete mode 100644 test-suite/bugs/closed/4292.v delete mode 100644 test-suite/bugs/closed/4293.v delete mode 100644 test-suite/bugs/closed/4294.v delete mode 100644 test-suite/bugs/closed/4298.v delete mode 100644 test-suite/bugs/closed/4299.v delete mode 100644 test-suite/bugs/closed/4301.v delete mode 100644 test-suite/bugs/closed/4305.v delete mode 100644 test-suite/bugs/closed/4306.v delete mode 100644 test-suite/bugs/closed/4316.v delete mode 100644 test-suite/bugs/closed/4318.v delete mode 100644 test-suite/bugs/closed/4325.v delete mode 100644 test-suite/bugs/closed/4328.v delete mode 100644 test-suite/bugs/closed/4346.v delete mode 100644 test-suite/bugs/closed/4347.v delete mode 100644 test-suite/bugs/closed/4354.v delete mode 100644 test-suite/bugs/closed/4363.v delete mode 100644 test-suite/bugs/closed/4366.v delete mode 100644 test-suite/bugs/closed/4372.v delete mode 100644 test-suite/bugs/closed/4375.v delete mode 100644 test-suite/bugs/closed/4378.v delete mode 100644 test-suite/bugs/closed/4390.v delete mode 100644 test-suite/bugs/closed/4397.v delete mode 100644 test-suite/bugs/closed/4403.v delete mode 100644 test-suite/bugs/closed/4404.v delete mode 100644 test-suite/bugs/closed/4412.v delete mode 100644 test-suite/bugs/closed/4416.v delete mode 100644 test-suite/bugs/closed/4420.v delete mode 100644 test-suite/bugs/closed/4429.v delete mode 100644 test-suite/bugs/closed/4433.v delete mode 100644 test-suite/bugs/closed/4443.v delete mode 100644 test-suite/bugs/closed/4450.v delete mode 100644 test-suite/bugs/closed/4453.v delete mode 100644 test-suite/bugs/closed/4456.v delete mode 100644 test-suite/bugs/closed/4462.v delete mode 100644 test-suite/bugs/closed/4464.v delete mode 100644 test-suite/bugs/closed/4467.v delete mode 100644 test-suite/bugs/closed/4471.v delete mode 100644 test-suite/bugs/closed/4479.v delete mode 100644 test-suite/bugs/closed/4480.v delete mode 100644 test-suite/bugs/closed/4484.v delete mode 100644 test-suite/bugs/closed/4495.v delete mode 100644 test-suite/bugs/closed/4498.v delete mode 100644 test-suite/bugs/closed/4503.v delete mode 100644 test-suite/bugs/closed/4511.v delete mode 100644 test-suite/bugs/closed/4519.v delete mode 100644 test-suite/bugs/closed/4527.v delete mode 100644 test-suite/bugs/closed/4529.v delete mode 100644 test-suite/bugs/closed/4533.v delete mode 100644 test-suite/bugs/closed/4538.v delete mode 100644 test-suite/bugs/closed/4544.v delete mode 100644 test-suite/bugs/closed/4574.v delete mode 100644 test-suite/bugs/closed/4576.v delete mode 100644 test-suite/bugs/closed/4580.v delete mode 100644 test-suite/bugs/closed/4582.v delete mode 100644 test-suite/bugs/closed/4588.v delete mode 100644 test-suite/bugs/closed/4596.v delete mode 100644 test-suite/bugs/closed/4603.v delete mode 100644 test-suite/bugs/closed/4612.v delete mode 100644 test-suite/bugs/closed/4616.v delete mode 100644 test-suite/bugs/closed/4622.v delete mode 100644 test-suite/bugs/closed/4623.v delete mode 100644 test-suite/bugs/closed/4624.v delete mode 100644 test-suite/bugs/closed/4627.v delete mode 100644 test-suite/bugs/closed/4628.v delete mode 100644 test-suite/bugs/closed/4634.v delete mode 100644 test-suite/bugs/closed/4644.v delete mode 100644 test-suite/bugs/closed/4653.v delete mode 100644 test-suite/bugs/closed/4661.v delete mode 100644 test-suite/bugs/closed/4663.v delete mode 100644 test-suite/bugs/closed/4670.v delete mode 100644 test-suite/bugs/closed/4673.v delete mode 100644 test-suite/bugs/closed/4679.v delete mode 100644 test-suite/bugs/closed/4684.v delete mode 100644 test-suite/bugs/closed/4695.v delete mode 100644 test-suite/bugs/closed/4708.v delete mode 100644 test-suite/bugs/closed/4709.v delete mode 100644 test-suite/bugs/closed/4710.v delete mode 100644 test-suite/bugs/closed/4713.v delete mode 100644 test-suite/bugs/closed/4717.v delete mode 100644 test-suite/bugs/closed/4718.v delete mode 100644 test-suite/bugs/closed/4720.v delete mode 100644 test-suite/bugs/closed/4723.v delete mode 100644 test-suite/bugs/closed/4725.v delete mode 100644 test-suite/bugs/closed/4726.v delete mode 100644 test-suite/bugs/closed/4737.v delete mode 100644 test-suite/bugs/closed/4745.v delete mode 100644 test-suite/bugs/closed/4746.v delete mode 100644 test-suite/bugs/closed/4754.v delete mode 100644 test-suite/bugs/closed/4762.v delete mode 100644 test-suite/bugs/closed/4763.v delete mode 100644 test-suite/bugs/closed/4764.v delete mode 100644 test-suite/bugs/closed/4769.v delete mode 100644 test-suite/bugs/closed/4772.v delete mode 100644 test-suite/bugs/closed/4780.v delete mode 100644 test-suite/bugs/closed/4782.v delete mode 100644 test-suite/bugs/closed/4785.v delete mode 100644 test-suite/bugs/closed/4787.v delete mode 100644 test-suite/bugs/closed/4798.v delete mode 100644 test-suite/bugs/closed/4811.v delete mode 100644 test-suite/bugs/closed/4813.v delete mode 100644 test-suite/bugs/closed/4816.v delete mode 100644 test-suite/bugs/closed/4818.v delete mode 100644 test-suite/bugs/closed/4844.v delete mode 100644 test-suite/bugs/closed/4852.v delete mode 100644 test-suite/bugs/closed/4858.v delete mode 100644 test-suite/bugs/closed/4859.v delete mode 100644 test-suite/bugs/closed/4863.v delete mode 100644 test-suite/bugs/closed/4865.v delete mode 100644 test-suite/bugs/closed/4869.v delete mode 100644 test-suite/bugs/closed/4873.v delete mode 100644 test-suite/bugs/closed/4877.v delete mode 100644 test-suite/bugs/closed/4880.v delete mode 100644 test-suite/bugs/closed/4893.v delete mode 100644 test-suite/bugs/closed/4904.v delete mode 100644 test-suite/bugs/closed/4932.v delete mode 100644 test-suite/bugs/closed/4955.v delete mode 100644 test-suite/bugs/closed/4957.v delete mode 100644 test-suite/bugs/closed/4966.v delete mode 100644 test-suite/bugs/closed/4969.v delete mode 100644 test-suite/bugs/closed/4970.v delete mode 100644 test-suite/bugs/closed/5011.v delete mode 100644 test-suite/bugs/closed/5012.v delete mode 100644 test-suite/bugs/closed/5019.v delete mode 100644 test-suite/bugs/closed/5036.v delete mode 100644 test-suite/bugs/closed/5043.v delete mode 100644 test-suite/bugs/closed/5045.v delete mode 100644 test-suite/bugs/closed/5065.v delete mode 100644 test-suite/bugs/closed/5066.v delete mode 100644 test-suite/bugs/closed/5077.v delete mode 100644 test-suite/bugs/closed/5078.v delete mode 100644 test-suite/bugs/closed/5093.v delete mode 100644 test-suite/bugs/closed/5095.v delete mode 100644 test-suite/bugs/closed/5096.v delete mode 100644 test-suite/bugs/closed/5097.v delete mode 100644 test-suite/bugs/closed/5123.v delete mode 100644 test-suite/bugs/closed/5127.v delete mode 100644 test-suite/bugs/closed/5145.v delete mode 100644 test-suite/bugs/closed/5149.v delete mode 100644 test-suite/bugs/closed/5153.v delete mode 100644 test-suite/bugs/closed/5161.v delete mode 100644 test-suite/bugs/closed/5177.v delete mode 100644 test-suite/bugs/closed/5180.v delete mode 100644 test-suite/bugs/closed/5181.v delete mode 100644 test-suite/bugs/closed/5188.v delete mode 100644 test-suite/bugs/closed/5193.v delete mode 100644 test-suite/bugs/closed/5198.v delete mode 100644 test-suite/bugs/closed/5203.v delete mode 100644 test-suite/bugs/closed/5205.v delete mode 100644 test-suite/bugs/closed/5208.v delete mode 100644 test-suite/bugs/closed/5215.v delete mode 100644 test-suite/bugs/closed/5215_2.v delete mode 100644 test-suite/bugs/closed/5219.v delete mode 100644 test-suite/bugs/closed/5233.v delete mode 100644 test-suite/bugs/closed/5245.v delete mode 100644 test-suite/bugs/closed/5255.v delete mode 100644 test-suite/bugs/closed/5277.v delete mode 100644 test-suite/bugs/closed/5281.v delete mode 100644 test-suite/bugs/closed/5286.v delete mode 100644 test-suite/bugs/closed/5300.v delete mode 100644 test-suite/bugs/closed/5315.v delete mode 100644 test-suite/bugs/closed/5321.v delete mode 100644 test-suite/bugs/closed/5322.v delete mode 100644 test-suite/bugs/closed/5323.v delete mode 100644 test-suite/bugs/closed/5331.v delete mode 100644 test-suite/bugs/closed/5345.v delete mode 100644 test-suite/bugs/closed/5346.v delete mode 100644 test-suite/bugs/closed/5347.v delete mode 100644 test-suite/bugs/closed/5359.v delete mode 100644 test-suite/bugs/closed/5365.v delete mode 100644 test-suite/bugs/closed/5368.v delete mode 100644 test-suite/bugs/closed/5372.v delete mode 100644 test-suite/bugs/closed/5377.v delete mode 100644 test-suite/bugs/closed/5401.v delete mode 100644 test-suite/bugs/closed/5414.v delete mode 100644 test-suite/bugs/closed/5434.v delete mode 100644 test-suite/bugs/closed/5435.v delete mode 100644 test-suite/bugs/closed/5449.v delete mode 100644 test-suite/bugs/closed/5460.v delete mode 100644 test-suite/bugs/closed/5470.v delete mode 100644 test-suite/bugs/closed/5476.v delete mode 100644 test-suite/bugs/closed/5486.v delete mode 100644 test-suite/bugs/closed/5487.v delete mode 100644 test-suite/bugs/closed/5500.v delete mode 100644 test-suite/bugs/closed/5501.v delete mode 100644 test-suite/bugs/closed/5522.v delete mode 100644 test-suite/bugs/closed/5523.v delete mode 100644 test-suite/bugs/closed/5526.v delete mode 100644 test-suite/bugs/closed/5532.v delete mode 100644 test-suite/bugs/closed/5539.v delete mode 100644 test-suite/bugs/closed/5547.v delete mode 100644 test-suite/bugs/closed/5550.v delete mode 100644 test-suite/bugs/closed/5578.v delete mode 100644 test-suite/bugs/closed/5598.v delete mode 100644 test-suite/bugs/closed/5608.v delete mode 100644 test-suite/bugs/closed/5618.v delete mode 100644 test-suite/bugs/closed/5641.v delete mode 100644 test-suite/bugs/closed/5666.v delete mode 100644 test-suite/bugs/closed/5671.v delete mode 100644 test-suite/bugs/closed/5683.v delete mode 100644 test-suite/bugs/closed/5692.v delete mode 100644 test-suite/bugs/closed/5696.v delete mode 100644 test-suite/bugs/closed/5697.v delete mode 100644 test-suite/bugs/closed/5707.v delete mode 100644 test-suite/bugs/closed/5713.v delete mode 100644 test-suite/bugs/closed/5717.v delete mode 100644 test-suite/bugs/closed/5719.v delete mode 100644 test-suite/bugs/closed/5726.v delete mode 100644 test-suite/bugs/closed/5741.v delete mode 100644 test-suite/bugs/closed/5749.v delete mode 100644 test-suite/bugs/closed/5750.v delete mode 100644 test-suite/bugs/closed/5755.v delete mode 100644 test-suite/bugs/closed/5757.v delete mode 100644 test-suite/bugs/closed/5761.v delete mode 100644 test-suite/bugs/closed/5762.v delete mode 100644 test-suite/bugs/closed/5765.v delete mode 100644 test-suite/bugs/closed/5769.v delete mode 100644 test-suite/bugs/closed/5786.v delete mode 100644 test-suite/bugs/closed/5790.v delete mode 100644 test-suite/bugs/closed/5797.v delete mode 100644 test-suite/bugs/closed/5845.v delete mode 100644 test-suite/bugs/closed/5940.v delete mode 100644 test-suite/bugs/closed/6070.v delete mode 100644 test-suite/bugs/closed/6129.v delete mode 100644 test-suite/bugs/closed/6191.v delete mode 100644 test-suite/bugs/closed/6297.v delete mode 100644 test-suite/bugs/closed/6313.v delete mode 100644 test-suite/bugs/closed/6323.v delete mode 100644 test-suite/bugs/closed/6378.v delete mode 100644 test-suite/bugs/closed/6490.v delete mode 100644 test-suite/bugs/closed/6529.v delete mode 100644 test-suite/bugs/closed/6534.v delete mode 100644 test-suite/bugs/closed/6617.v delete mode 100644 test-suite/bugs/closed/6631.v delete mode 100644 test-suite/bugs/closed/6634.v delete mode 100644 test-suite/bugs/closed/6661.v delete mode 100644 test-suite/bugs/closed/6677.v delete mode 100644 test-suite/bugs/closed/6770.v delete mode 100644 test-suite/bugs/closed/6774.v delete mode 100644 test-suite/bugs/closed/6775.v delete mode 100644 test-suite/bugs/closed/6878.v delete mode 100644 test-suite/bugs/closed/6910.v delete mode 100644 test-suite/bugs/closed/6951.v delete mode 100644 test-suite/bugs/closed/6956.v delete mode 100644 test-suite/bugs/closed/7011.v delete mode 100644 test-suite/bugs/closed/7068.v delete mode 100644 test-suite/bugs/closed/7076.v delete mode 100644 test-suite/bugs/closed/7092.v delete mode 100644 test-suite/bugs/closed/7113.v delete mode 100644 test-suite/bugs/closed/7195.v delete mode 100644 test-suite/bugs/closed/7333.v delete mode 100644 test-suite/bugs/closed/7392.v delete mode 100644 test-suite/bugs/closed/7421.v delete mode 100644 test-suite/bugs/closed/7462.v delete mode 100644 test-suite/bugs/closed/7554.v delete mode 100644 test-suite/bugs/closed/7615.v delete mode 100644 test-suite/bugs/closed/7631.v delete mode 100644 test-suite/bugs/closed/7695.v delete mode 100644 test-suite/bugs/closed/7700.v delete mode 100644 test-suite/bugs/closed/7712.v delete mode 100644 test-suite/bugs/closed/7723.v delete mode 100644 test-suite/bugs/closed/7754.v delete mode 100644 test-suite/bugs/closed/7779.v delete mode 100644 test-suite/bugs/closed/7780.v delete mode 100644 test-suite/bugs/closed/7795.v delete mode 100644 test-suite/bugs/closed/7811.v delete mode 100644 test-suite/bugs/closed/7854.v delete mode 100644 test-suite/bugs/closed/7867.v delete mode 100644 test-suite/bugs/closed/7900.v delete mode 100644 test-suite/bugs/closed/7903.v delete mode 100644 test-suite/bugs/closed/7967.v delete mode 100644 test-suite/bugs/closed/8004.v delete mode 100644 test-suite/bugs/closed/8081.v delete mode 100644 test-suite/bugs/closed/808_2411.v delete mode 100644 test-suite/bugs/closed/8106.v delete mode 100644 test-suite/bugs/closed/8119.v delete mode 100644 test-suite/bugs/closed/8121.v delete mode 100644 test-suite/bugs/closed/8126.v delete mode 100644 test-suite/bugs/closed/8215.v delete mode 100644 test-suite/bugs/closed/8270.v delete mode 100644 test-suite/bugs/closed/8288.v delete mode 100644 test-suite/bugs/closed/8432.v delete mode 100644 test-suite/bugs/closed/8478.v delete mode 100644 test-suite/bugs/closed/8532.v create mode 100644 test-suite/bugs/closed/bug_1238.v create mode 100644 test-suite/bugs/closed/bug_1243.v create mode 100644 test-suite/bugs/closed/bug_1302.v create mode 100644 test-suite/bugs/closed/bug_1322.v create mode 100644 test-suite/bugs/closed/bug_1341.v create mode 100644 test-suite/bugs/closed/bug_1362.v create mode 100644 test-suite/bugs/closed/bug_1411.v create mode 100644 test-suite/bugs/closed/bug_1414.v create mode 100644 test-suite/bugs/closed/bug_1416.v create mode 100644 test-suite/bugs/closed/bug_1419.v create mode 100644 test-suite/bugs/closed/bug_1425.v create mode 100644 test-suite/bugs/closed/bug_1446.v create mode 100644 test-suite/bugs/closed/bug_1448.v create mode 100644 test-suite/bugs/closed/bug_1477.v create mode 100644 test-suite/bugs/closed/bug_1483.v create mode 100644 test-suite/bugs/closed/bug_1501.v create mode 100644 test-suite/bugs/closed/bug_1507.v create mode 100644 test-suite/bugs/closed/bug_1519.v create mode 100644 test-suite/bugs/closed/bug_1542.v create mode 100644 test-suite/bugs/closed/bug_1543.v create mode 100644 test-suite/bugs/closed/bug_1545.v create mode 100644 test-suite/bugs/closed/bug_1547.v create mode 100644 test-suite/bugs/closed/bug_1551.v create mode 100644 test-suite/bugs/closed/bug_1568.v create mode 100644 test-suite/bugs/closed/bug_1576.v create mode 100644 test-suite/bugs/closed/bug_1582.v create mode 100644 test-suite/bugs/closed/bug_1584.v create mode 100644 test-suite/bugs/closed/bug_1604.v create mode 100644 test-suite/bugs/closed/bug_1614.v create mode 100644 test-suite/bugs/closed/bug_1618.v create mode 100644 test-suite/bugs/closed/bug_1634.v create mode 100644 test-suite/bugs/closed/bug_1643.v create mode 100644 test-suite/bugs/closed/bug_1680.v create mode 100644 test-suite/bugs/closed/bug_1683.v create mode 100644 test-suite/bugs/closed/bug_1696.v create mode 100644 test-suite/bugs/closed/bug_1703.v create mode 100644 test-suite/bugs/closed/bug_1704.v create mode 100644 test-suite/bugs/closed/bug_1711.v create mode 100644 test-suite/bugs/closed/bug_1718.v create mode 100644 test-suite/bugs/closed/bug_1738.v create mode 100644 test-suite/bugs/closed/bug_1740.v create mode 100644 test-suite/bugs/closed/bug_1754.v create mode 100644 test-suite/bugs/closed/bug_1773.v create mode 100644 test-suite/bugs/closed/bug_1774.v create mode 100644 test-suite/bugs/closed/bug_1775.v create mode 100644 test-suite/bugs/closed/bug_1776.v create mode 100644 test-suite/bugs/closed/bug_1779.v create mode 100644 test-suite/bugs/closed/bug_1780.v create mode 100644 test-suite/bugs/closed/bug_1784.v create mode 100644 test-suite/bugs/closed/bug_1787.v create mode 100644 test-suite/bugs/closed/bug_1791.v create mode 100644 test-suite/bugs/closed/bug_1834.v create mode 100644 test-suite/bugs/closed/bug_1844.v create mode 100644 test-suite/bugs/closed/bug_1850.v create mode 100644 test-suite/bugs/closed/bug_1859.v create mode 100644 test-suite/bugs/closed/bug_1865.v create mode 100644 test-suite/bugs/closed/bug_1891.v create mode 100644 test-suite/bugs/closed/bug_1898.v create mode 100644 test-suite/bugs/closed/bug_1900.v create mode 100644 test-suite/bugs/closed/bug_1901.v create mode 100644 test-suite/bugs/closed/bug_1905.v create mode 100644 test-suite/bugs/closed/bug_1907.v create mode 100644 test-suite/bugs/closed/bug_1912.v create mode 100644 test-suite/bugs/closed/bug_1915.v create mode 100644 test-suite/bugs/closed/bug_1918.v create mode 100644 test-suite/bugs/closed/bug_1925.v create mode 100644 test-suite/bugs/closed/bug_1931.v create mode 100644 test-suite/bugs/closed/bug_1935.v create mode 100644 test-suite/bugs/closed/bug_1939.v create mode 100644 test-suite/bugs/closed/bug_1944.v create mode 100644 test-suite/bugs/closed/bug_1951.v create mode 100644 test-suite/bugs/closed/bug_1962.v create mode 100644 test-suite/bugs/closed/bug_1963.v create mode 100644 test-suite/bugs/closed/bug_1977.v create mode 100644 test-suite/bugs/closed/bug_1981.v create mode 100644 test-suite/bugs/closed/bug_2001.v create mode 100644 test-suite/bugs/closed/bug_2006.v create mode 100644 test-suite/bugs/closed/bug_2016.v create mode 100644 test-suite/bugs/closed/bug_2017.v create mode 100644 test-suite/bugs/closed/bug_2021.v create mode 100644 test-suite/bugs/closed/bug_2027.v create mode 100644 test-suite/bugs/closed/bug_2083.v create mode 100644 test-suite/bugs/closed/bug_2089.v create mode 100644 test-suite/bugs/closed/bug_2095.v create mode 100644 test-suite/bugs/closed/bug_2105.v create mode 100644 test-suite/bugs/closed/bug_2108.v create mode 100644 test-suite/bugs/closed/bug_2117.v create mode 100644 test-suite/bugs/closed/bug_2123.v create mode 100644 test-suite/bugs/closed/bug_2127.v create mode 100644 test-suite/bugs/closed/bug_2135.v create mode 100644 test-suite/bugs/closed/bug_2136.v create mode 100644 test-suite/bugs/closed/bug_2137.v create mode 100644 test-suite/bugs/closed/bug_2139.v create mode 100644 test-suite/bugs/closed/bug_2141.v create mode 100644 test-suite/bugs/closed/bug_2145.v create mode 100644 test-suite/bugs/closed/bug_2149.v create mode 100644 test-suite/bugs/closed/bug_2164.v create mode 100644 test-suite/bugs/closed/bug_2181.v create mode 100644 test-suite/bugs/closed/bug_2193.v create mode 100644 test-suite/bugs/closed/bug_2230.v create mode 100644 test-suite/bugs/closed/bug_2231.v create mode 100644 test-suite/bugs/closed/bug_2243.v create mode 100644 test-suite/bugs/closed/bug_2244.v create mode 100644 test-suite/bugs/closed/bug_2245.v create mode 100644 test-suite/bugs/closed/bug_2250.v create mode 100644 test-suite/bugs/closed/bug_2251.v create mode 100644 test-suite/bugs/closed/bug_2255.v create mode 100644 test-suite/bugs/closed/bug_2262.v create mode 100644 test-suite/bugs/closed/bug_2281.v create mode 100644 test-suite/bugs/closed/bug_2295.v create mode 100644 test-suite/bugs/closed/bug_2299.v create mode 100644 test-suite/bugs/closed/bug_2300.v create mode 100644 test-suite/bugs/closed/bug_2303.v create mode 100644 test-suite/bugs/closed/bug_2304.v create mode 100644 test-suite/bugs/closed/bug_2307.v create mode 100644 test-suite/bugs/closed/bug_2310.v create mode 100644 test-suite/bugs/closed/bug_2319.v create mode 100644 test-suite/bugs/closed/bug_2320.v create mode 100644 test-suite/bugs/closed/bug_2342.v create mode 100644 test-suite/bugs/closed/bug_2347.v create mode 100644 test-suite/bugs/closed/bug_2350.v create mode 100644 test-suite/bugs/closed/bug_2353.v create mode 100644 test-suite/bugs/closed/bug_2360.v create mode 100644 test-suite/bugs/closed/bug_2362.v create mode 100644 test-suite/bugs/closed/bug_2375.v create mode 100644 test-suite/bugs/closed/bug_2378.v create mode 100644 test-suite/bugs/closed/bug_2388.v create mode 100644 test-suite/bugs/closed/bug_2393.v create mode 100644 test-suite/bugs/closed/bug_2404.v create mode 100644 test-suite/bugs/closed/bug_2406.v create mode 100644 test-suite/bugs/closed/bug_2417.v create mode 100644 test-suite/bugs/closed/bug_2428.v create mode 100644 test-suite/bugs/closed/bug_2447.v create mode 100644 test-suite/bugs/closed/bug_2456.v create mode 100644 test-suite/bugs/closed/bug_2464.v create mode 100644 test-suite/bugs/closed/bug_2467.v create mode 100644 test-suite/bugs/closed/bug_2473.v create mode 100644 test-suite/bugs/closed/bug_2584.v create mode 100644 test-suite/bugs/closed/bug_2586.v create mode 100644 test-suite/bugs/closed/bug_2590.v create mode 100644 test-suite/bugs/closed/bug_2602.v create mode 100644 test-suite/bugs/closed/bug_2603.v create mode 100644 test-suite/bugs/closed/bug_2608.v create mode 100644 test-suite/bugs/closed/bug_2613.v create mode 100644 test-suite/bugs/closed/bug_2615.v create mode 100644 test-suite/bugs/closed/bug_2616.v create mode 100644 test-suite/bugs/closed/bug_2629.v create mode 100644 test-suite/bugs/closed/bug_2667.v create mode 100644 test-suite/bugs/closed/bug_2668.v create mode 100644 test-suite/bugs/closed/bug_2670.v create mode 100644 test-suite/bugs/closed/bug_2680.v create mode 100644 test-suite/bugs/closed/bug_2713.v create mode 100644 test-suite/bugs/closed/bug_2729.v create mode 100644 test-suite/bugs/closed/bug_2732.v create mode 100644 test-suite/bugs/closed/bug_2733.v create mode 100644 test-suite/bugs/closed/bug_2734.v create mode 100644 test-suite/bugs/closed/bug_2750.v create mode 100644 test-suite/bugs/closed/bug_2775.v create mode 100644 test-suite/bugs/closed/bug_2800.v create mode 100644 test-suite/bugs/closed/bug_2810.v create mode 100644 test-suite/bugs/closed/bug_2814.v create mode 100644 test-suite/bugs/closed/bug_2817.v create mode 100644 test-suite/bugs/closed/bug_2818.v create mode 100644 test-suite/bugs/closed/bug_2828.v create mode 100644 test-suite/bugs/closed/bug_2830.v create mode 100644 test-suite/bugs/closed/bug_2834.v create mode 100644 test-suite/bugs/closed/bug_2836.v create mode 100644 test-suite/bugs/closed/bug_2837.v create mode 100644 test-suite/bugs/closed/bug_2839.v create mode 100644 test-suite/bugs/closed/bug_2846.v create mode 100644 test-suite/bugs/closed/bug_2848.v create mode 100644 test-suite/bugs/closed/bug_2854.v create mode 100644 test-suite/bugs/closed/bug_2876.v create mode 100644 test-suite/bugs/closed/bug_2881.v create mode 100644 test-suite/bugs/closed/bug_2883.v create mode 100644 test-suite/bugs/closed/bug_2900.v create mode 100644 test-suite/bugs/closed/bug_2920.v create mode 100644 test-suite/bugs/closed/bug_2923.v create mode 100644 test-suite/bugs/closed/bug_2928.v create mode 100644 test-suite/bugs/closed/bug_2930.v create mode 100644 test-suite/bugs/closed/bug_2945.v create mode 100644 test-suite/bugs/closed/bug_2946.v create mode 100644 test-suite/bugs/closed/bug_2951.v create mode 100644 test-suite/bugs/closed/bug_2955.v create mode 100644 test-suite/bugs/closed/bug_2966.v create mode 100644 test-suite/bugs/closed/bug_2969.v create mode 100644 test-suite/bugs/closed/bug_2981.v create mode 100644 test-suite/bugs/closed/bug_2983.v create mode 100644 test-suite/bugs/closed/bug_2990.v create mode 100644 test-suite/bugs/closed/bug_2994.v create mode 100644 test-suite/bugs/closed/bug_2995.v create mode 100644 test-suite/bugs/closed/bug_2996.v create mode 100644 test-suite/bugs/closed/bug_3000.v create mode 100644 test-suite/bugs/closed/bug_3001.v create mode 100644 test-suite/bugs/closed/bug_3003.v create mode 100644 test-suite/bugs/closed/bug_3004.v create mode 100644 test-suite/bugs/closed/bug_3008.v create mode 100644 test-suite/bugs/closed/bug_3010b.v create mode 100644 test-suite/bugs/closed/bug_3016.v create mode 100644 test-suite/bugs/closed/bug_3017.v create mode 100644 test-suite/bugs/closed/bug_3022.v create mode 100644 test-suite/bugs/closed/bug_3023.v create mode 100644 test-suite/bugs/closed/bug_3036.v create mode 100644 test-suite/bugs/closed/bug_3037.v create mode 100644 test-suite/bugs/closed/bug_3043.v create mode 100644 test-suite/bugs/closed/bug_3045.v create mode 100644 test-suite/bugs/closed/bug_3050.v create mode 100644 test-suite/bugs/closed/bug_3054.v create mode 100644 test-suite/bugs/closed/bug_3062.v create mode 100644 test-suite/bugs/closed/bug_3068.v create mode 100644 test-suite/bugs/closed/bug_3070.v create mode 100644 test-suite/bugs/closed/bug_3071.v create mode 100644 test-suite/bugs/closed/bug_3080.v create mode 100644 test-suite/bugs/closed/bug_3088.v create mode 100644 test-suite/bugs/closed/bug_3093.v create mode 100644 test-suite/bugs/closed/bug_3100.v create mode 100644 test-suite/bugs/closed/bug_3125.v create mode 100644 test-suite/bugs/closed/bug_3142.v create mode 100644 test-suite/bugs/closed/bug_3164.v create mode 100644 test-suite/bugs/closed/bug_3188.v create mode 100644 test-suite/bugs/closed/bug_3199.v create mode 100644 test-suite/bugs/closed/bug_3205.v create mode 100644 test-suite/bugs/closed/bug_3209.v create mode 100644 test-suite/bugs/closed/bug_3210.v create mode 100644 test-suite/bugs/closed/bug_3212.v create mode 100644 test-suite/bugs/closed/bug_3217.v create mode 100644 test-suite/bugs/closed/bug_3228.v create mode 100644 test-suite/bugs/closed/bug_3230.v create mode 100644 test-suite/bugs/closed/bug_3242.v create mode 100644 test-suite/bugs/closed/bug_3249.v create mode 100644 test-suite/bugs/closed/bug_3251.v create mode 100644 test-suite/bugs/closed/bug_3257.v create mode 100644 test-suite/bugs/closed/bug_3258.v create mode 100644 test-suite/bugs/closed/bug_3259.v create mode 100644 test-suite/bugs/closed/bug_3260.v create mode 100644 test-suite/bugs/closed/bug_3262.v create mode 100644 test-suite/bugs/closed/bug_3264.v create mode 100644 test-suite/bugs/closed/bug_3265.v create mode 100644 test-suite/bugs/closed/bug_3266.v create mode 100644 test-suite/bugs/closed/bug_3267.v create mode 100644 test-suite/bugs/closed/bug_3281.v create mode 100644 test-suite/bugs/closed/bug_3282.v create mode 100644 test-suite/bugs/closed/bug_3284.v create mode 100644 test-suite/bugs/closed/bug_3285.v create mode 100644 test-suite/bugs/closed/bug_3286.v create mode 100644 test-suite/bugs/closed/bug_3287.v create mode 100644 test-suite/bugs/closed/bug_3289.v create mode 100644 test-suite/bugs/closed/bug_3291.v create mode 100644 test-suite/bugs/closed/bug_3294.v create mode 100644 test-suite/bugs/closed/bug_3297.v create mode 100644 test-suite/bugs/closed/bug_3298.v create mode 100644 test-suite/bugs/closed/bug_3300.v create mode 100644 test-suite/bugs/closed/bug_3305.v create mode 100644 test-suite/bugs/closed/bug_3306.v create mode 100644 test-suite/bugs/closed/bug_3310.v create mode 100644 test-suite/bugs/closed/bug_3314.v create mode 100644 test-suite/bugs/closed/bug_3315.v create mode 100644 test-suite/bugs/closed/bug_3317.v create mode 100644 test-suite/bugs/closed/bug_3319.v create mode 100644 test-suite/bugs/closed/bug_3320.v create mode 100644 test-suite/bugs/closed/bug_3321.v create mode 100644 test-suite/bugs/closed/bug_3322.v create mode 100644 test-suite/bugs/closed/bug_3323.v create mode 100644 test-suite/bugs/closed/bug_3324.v create mode 100644 test-suite/bugs/closed/bug_3325.v create mode 100644 test-suite/bugs/closed/bug_3326.v create mode 100644 test-suite/bugs/closed/bug_3329.v create mode 100644 test-suite/bugs/closed/bug_3330.v create mode 100644 test-suite/bugs/closed/bug_3331.v create mode 100644 test-suite/bugs/closed/bug_3332.v create mode 100644 test-suite/bugs/closed/bug_3336.v create mode 100644 test-suite/bugs/closed/bug_3337.v create mode 100644 test-suite/bugs/closed/bug_3338.v create mode 100644 test-suite/bugs/closed/bug_3344.v create mode 100644 test-suite/bugs/closed/bug_3346.v create mode 100644 test-suite/bugs/closed/bug_3347.v create mode 100644 test-suite/bugs/closed/bug_3348.v create mode 100644 test-suite/bugs/closed/bug_3350.v create mode 100644 test-suite/bugs/closed/bug_3352.v create mode 100644 test-suite/bugs/closed/bug_3354.v create mode 100644 test-suite/bugs/closed/bug_3355.v create mode 100644 test-suite/bugs/closed/bug_3368.v create mode 100644 test-suite/bugs/closed/bug_3372.v create mode 100644 test-suite/bugs/closed/bug_3373.v create mode 100644 test-suite/bugs/closed/bug_3374.v create mode 100644 test-suite/bugs/closed/bug_3375.v create mode 100644 test-suite/bugs/closed/bug_3377.v create mode 100644 test-suite/bugs/closed/bug_3382.v create mode 100644 test-suite/bugs/closed/bug_3383.v create mode 100644 test-suite/bugs/closed/bug_3386.v create mode 100644 test-suite/bugs/closed/bug_3387.v create mode 100644 test-suite/bugs/closed/bug_3388.v create mode 100644 test-suite/bugs/closed/bug_3390.v create mode 100644 test-suite/bugs/closed/bug_3392.v create mode 100644 test-suite/bugs/closed/bug_3393.v create mode 100644 test-suite/bugs/closed/bug_3402.v create mode 100644 test-suite/bugs/closed/bug_3408.v create mode 100644 test-suite/bugs/closed/bug_3416.v create mode 100644 test-suite/bugs/closed/bug_3417.v create mode 100644 test-suite/bugs/closed/bug_3422.v create mode 100644 test-suite/bugs/closed/bug_3427.v create mode 100644 test-suite/bugs/closed/bug_3428.v create mode 100644 test-suite/bugs/closed/bug_3439.v create mode 100644 test-suite/bugs/closed/bug_3441.v create mode 100644 test-suite/bugs/closed/bug_3446.v create mode 100644 test-suite/bugs/closed/bug_3453.v create mode 100644 test-suite/bugs/closed/bug_3454.v create mode 100644 test-suite/bugs/closed/bug_3461.v create mode 100644 test-suite/bugs/closed/bug_3467.v create mode 100644 test-suite/bugs/closed/bug_3469.v create mode 100644 test-suite/bugs/closed/bug_3477.v create mode 100644 test-suite/bugs/closed/bug_3480.v create mode 100644 test-suite/bugs/closed/bug_3481.v create mode 100644 test-suite/bugs/closed/bug_3482.v create mode 100644 test-suite/bugs/closed/bug_3483.v create mode 100644 test-suite/bugs/closed/bug_3484.v create mode 100644 test-suite/bugs/closed/bug_3485.v create mode 100644 test-suite/bugs/closed/bug_3487.v create mode 100644 test-suite/bugs/closed/bug_3490.v create mode 100644 test-suite/bugs/closed/bug_3491.v create mode 100644 test-suite/bugs/closed/bug_3495.v create mode 100644 test-suite/bugs/closed/bug_3505.v create mode 100644 test-suite/bugs/closed/bug_3509.v create mode 100644 test-suite/bugs/closed/bug_3510.v create mode 100644 test-suite/bugs/closed/bug_3513.v create mode 100644 test-suite/bugs/closed/bug_3520.v create mode 100644 test-suite/bugs/closed/bug_3531.v create mode 100644 test-suite/bugs/closed/bug_3537.v create mode 100644 test-suite/bugs/closed/bug_3539.v create mode 100644 test-suite/bugs/closed/bug_3542.v create mode 100644 test-suite/bugs/closed/bug_3546.v create mode 100644 test-suite/bugs/closed/bug_3554.v create mode 100644 test-suite/bugs/closed/bug_3559.v create mode 100644 test-suite/bugs/closed/bug_3560.v create mode 100644 test-suite/bugs/closed/bug_3561.v create mode 100644 test-suite/bugs/closed/bug_3562.v create mode 100644 test-suite/bugs/closed/bug_3563.v create mode 100644 test-suite/bugs/closed/bug_3566.v create mode 100644 test-suite/bugs/closed/bug_3567.v create mode 100644 test-suite/bugs/closed/bug_3584.v create mode 100644 test-suite/bugs/closed/bug_3590.v create mode 100644 test-suite/bugs/closed/bug_3593.v create mode 100644 test-suite/bugs/closed/bug_3594.v create mode 100644 test-suite/bugs/closed/bug_3596.v create mode 100644 test-suite/bugs/closed/bug_3612.v create mode 100644 test-suite/bugs/closed/bug_3616.v create mode 100644 test-suite/bugs/closed/bug_3618.v create mode 100644 test-suite/bugs/closed/bug_3623.v create mode 100644 test-suite/bugs/closed/bug_3624.v create mode 100644 test-suite/bugs/closed/bug_3625.v create mode 100644 test-suite/bugs/closed/bug_3628.v create mode 100644 test-suite/bugs/closed/bug_3633.v create mode 100644 test-suite/bugs/closed/bug_3637.v create mode 100644 test-suite/bugs/closed/bug_3638.v create mode 100644 test-suite/bugs/closed/bug_3640.v create mode 100644 test-suite/bugs/closed/bug_3641.v create mode 100644 test-suite/bugs/closed/bug_3647.v create mode 100644 test-suite/bugs/closed/bug_3648.v create mode 100644 test-suite/bugs/closed/bug_3649.v create mode 100644 test-suite/bugs/closed/bug_3652.v create mode 100644 test-suite/bugs/closed/bug_3653.v create mode 100644 test-suite/bugs/closed/bug_3654.v create mode 100644 test-suite/bugs/closed/bug_3656.v create mode 100644 test-suite/bugs/closed/bug_3657.v create mode 100644 test-suite/bugs/closed/bug_3658.v create mode 100644 test-suite/bugs/closed/bug_3660.v create mode 100644 test-suite/bugs/closed/bug_3661.v create mode 100644 test-suite/bugs/closed/bug_3662.v create mode 100644 test-suite/bugs/closed/bug_3664.v create mode 100644 test-suite/bugs/closed/bug_3665.v create mode 100644 test-suite/bugs/closed/bug_3666.v create mode 100644 test-suite/bugs/closed/bug_3667.v create mode 100644 test-suite/bugs/closed/bug_3668.v create mode 100644 test-suite/bugs/closed/bug_3670.v create mode 100644 test-suite/bugs/closed/bug_3672.v create mode 100644 test-suite/bugs/closed/bug_3675.v create mode 100644 test-suite/bugs/closed/bug_3681.v create mode 100644 test-suite/bugs/closed/bug_3682.v create mode 100644 test-suite/bugs/closed/bug_3684.v create mode 100644 test-suite/bugs/closed/bug_3685.v create mode 100644 test-suite/bugs/closed/bug_3686.v create mode 100644 test-suite/bugs/closed/bug_3690.v create mode 100644 test-suite/bugs/closed/bug_3692.v create mode 100644 test-suite/bugs/closed/bug_3698.v create mode 100644 test-suite/bugs/closed/bug_3699.v create mode 100644 test-suite/bugs/closed/bug_3700.v create mode 100644 test-suite/bugs/closed/bug_3703.v create mode 100644 test-suite/bugs/closed/bug_3709.v create mode 100644 test-suite/bugs/closed/bug_3710.v create mode 100644 test-suite/bugs/closed/bug_3723.v create mode 100644 test-suite/bugs/closed/bug_3732.v create mode 100644 test-suite/bugs/closed/bug_3735.v create mode 100644 test-suite/bugs/closed/bug_3736.v create mode 100644 test-suite/bugs/closed/bug_3743.v create mode 100644 test-suite/bugs/closed/bug_3746.v create mode 100644 test-suite/bugs/closed/bug_3753.v create mode 100644 test-suite/bugs/closed/bug_3755.v create mode 100644 test-suite/bugs/closed/bug_3777.v create mode 100644 test-suite/bugs/closed/bug_3779.v create mode 100644 test-suite/bugs/closed/bug_3782.v create mode 100644 test-suite/bugs/closed/bug_3783.v create mode 100644 test-suite/bugs/closed/bug_3786.v create mode 100644 test-suite/bugs/closed/bug_3788.v create mode 100644 test-suite/bugs/closed/bug_3792.v create mode 100644 test-suite/bugs/closed/bug_3798.v create mode 100644 test-suite/bugs/closed/bug_3804.v create mode 100644 test-suite/bugs/closed/bug_3807.v create mode 100644 test-suite/bugs/closed/bug_3808.v create mode 100644 test-suite/bugs/closed/bug_3815.v create mode 100644 test-suite/bugs/closed/bug_3819.v create mode 100644 test-suite/bugs/closed/bug_3821.v create mode 100644 test-suite/bugs/closed/bug_3825.v create mode 100644 test-suite/bugs/closed/bug_3828.v create mode 100644 test-suite/bugs/closed/bug_3848.v create mode 100644 test-suite/bugs/closed/bug_3849.v create mode 100644 test-suite/bugs/closed/bug_3854.v create mode 100644 test-suite/bugs/closed/bug_3881.v create mode 100644 test-suite/bugs/closed/bug_3886.v create mode 100644 test-suite/bugs/closed/bug_3892.v create mode 100644 test-suite/bugs/closed/bug_3895.v create mode 100644 test-suite/bugs/closed/bug_3896.v create mode 100644 test-suite/bugs/closed/bug_3899.v create mode 100644 test-suite/bugs/closed/bug_3900.v create mode 100644 test-suite/bugs/closed/bug_3911.v create mode 100644 test-suite/bugs/closed/bug_3916.v create mode 100644 test-suite/bugs/closed/bug_3920.v create mode 100644 test-suite/bugs/closed/bug_3922.v create mode 100644 test-suite/bugs/closed/bug_3923.v create mode 100644 test-suite/bugs/closed/bug_3929.v create mode 100644 test-suite/bugs/closed/bug_3938.v create mode 100644 test-suite/bugs/closed/bug_3943.v create mode 100644 test-suite/bugs/closed/bug_3944.v create mode 100644 test-suite/bugs/closed/bug_3948.v create mode 100644 test-suite/bugs/closed/bug_3953.v create mode 100644 test-suite/bugs/closed/bug_3956.v create mode 100644 test-suite/bugs/closed/bug_3957.v create mode 100644 test-suite/bugs/closed/bug_3960.v create mode 100644 test-suite/bugs/closed/bug_3974.v create mode 100644 test-suite/bugs/closed/bug_3975.v create mode 100644 test-suite/bugs/closed/bug_3978.v create mode 100644 test-suite/bugs/closed/bug_3993.v create mode 100644 test-suite/bugs/closed/bug_3998.v create mode 100644 test-suite/bugs/closed/bug_4001.v create mode 100644 test-suite/bugs/closed/bug_4012.v create mode 100644 test-suite/bugs/closed/bug_4016.v create mode 100644 test-suite/bugs/closed/bug_4017.v create mode 100644 test-suite/bugs/closed/bug_4018.v create mode 100644 test-suite/bugs/closed/bug_4031.v create mode 100644 test-suite/bugs/closed/bug_4034.v create mode 100644 test-suite/bugs/closed/bug_4035.v create mode 100644 test-suite/bugs/closed/bug_4046.v create mode 100644 test-suite/bugs/closed/bug_4057.v create mode 100644 test-suite/bugs/closed/bug_4069.v create mode 100644 test-suite/bugs/closed/bug_4078.v create mode 100644 test-suite/bugs/closed/bug_4089.v create mode 100644 test-suite/bugs/closed/bug_4095.v create mode 100644 test-suite/bugs/closed/bug_4097.v create mode 100644 test-suite/bugs/closed/bug_4101.v create mode 100644 test-suite/bugs/closed/bug_4103.v create mode 100644 test-suite/bugs/closed/bug_4116.v create mode 100644 test-suite/bugs/closed/bug_4120.v create mode 100644 test-suite/bugs/closed/bug_4121.v create mode 100644 test-suite/bugs/closed/bug_4132.v create mode 100644 test-suite/bugs/closed/bug_4149.v create mode 100644 test-suite/bugs/closed/bug_4151.v create mode 100644 test-suite/bugs/closed/bug_4161.v create mode 100644 test-suite/bugs/closed/bug_4165.v create mode 100644 test-suite/bugs/closed/bug_4187.v create mode 100644 test-suite/bugs/closed/bug_4190.v create mode 100644 test-suite/bugs/closed/bug_4191.v create mode 100644 test-suite/bugs/closed/bug_4193.v create mode 100644 test-suite/bugs/closed/bug_4198.v create mode 100644 test-suite/bugs/closed/bug_4202.v create mode 100644 test-suite/bugs/closed/bug_4203.v create mode 100644 test-suite/bugs/closed/bug_4205.v create mode 100644 test-suite/bugs/closed/bug_4214.v create mode 100644 test-suite/bugs/closed/bug_4216.v create mode 100644 test-suite/bugs/closed/bug_4217.v create mode 100644 test-suite/bugs/closed/bug_4221.v create mode 100644 test-suite/bugs/closed/bug_4232.v create mode 100644 test-suite/bugs/closed/bug_4234.v create mode 100644 test-suite/bugs/closed/bug_4240.v create mode 100644 test-suite/bugs/closed/bug_4250.v create mode 100644 test-suite/bugs/closed/bug_4251.v create mode 100644 test-suite/bugs/closed/bug_4254.v create mode 100644 test-suite/bugs/closed/bug_4256.v create mode 100644 test-suite/bugs/closed/bug_4272.v create mode 100644 test-suite/bugs/closed/bug_4273.v create mode 100644 test-suite/bugs/closed/bug_4276.v create mode 100644 test-suite/bugs/closed/bug_4280.v create mode 100644 test-suite/bugs/closed/bug_4283.v create mode 100644 test-suite/bugs/closed/bug_4284.v create mode 100644 test-suite/bugs/closed/bug_4287.v create mode 100644 test-suite/bugs/closed/bug_4292.v create mode 100644 test-suite/bugs/closed/bug_4293.v create mode 100644 test-suite/bugs/closed/bug_4294.v create mode 100644 test-suite/bugs/closed/bug_4298.v create mode 100644 test-suite/bugs/closed/bug_4299.v create mode 100644 test-suite/bugs/closed/bug_4301.v create mode 100644 test-suite/bugs/closed/bug_4305.v create mode 100644 test-suite/bugs/closed/bug_4306.v create mode 100644 test-suite/bugs/closed/bug_4316.v create mode 100644 test-suite/bugs/closed/bug_4318.v create mode 100644 test-suite/bugs/closed/bug_4325.v create mode 100644 test-suite/bugs/closed/bug_4328.v create mode 100644 test-suite/bugs/closed/bug_4346.v create mode 100644 test-suite/bugs/closed/bug_4347.v create mode 100644 test-suite/bugs/closed/bug_4354.v create mode 100644 test-suite/bugs/closed/bug_4363.v create mode 100644 test-suite/bugs/closed/bug_4366.v create mode 100644 test-suite/bugs/closed/bug_4372.v create mode 100644 test-suite/bugs/closed/bug_4375.v create mode 100644 test-suite/bugs/closed/bug_4378.v create mode 100644 test-suite/bugs/closed/bug_4390.v create mode 100644 test-suite/bugs/closed/bug_4397.v create mode 100644 test-suite/bugs/closed/bug_4403.v create mode 100644 test-suite/bugs/closed/bug_4404.v create mode 100644 test-suite/bugs/closed/bug_4412.v create mode 100644 test-suite/bugs/closed/bug_4416.v create mode 100644 test-suite/bugs/closed/bug_4420.v create mode 100644 test-suite/bugs/closed/bug_4429.v create mode 100644 test-suite/bugs/closed/bug_4433.v create mode 100644 test-suite/bugs/closed/bug_4443.v create mode 100644 test-suite/bugs/closed/bug_4450.v create mode 100644 test-suite/bugs/closed/bug_4453.v create mode 100644 test-suite/bugs/closed/bug_4456.v create mode 100644 test-suite/bugs/closed/bug_4462.v create mode 100644 test-suite/bugs/closed/bug_4464.v create mode 100644 test-suite/bugs/closed/bug_4467.v create mode 100644 test-suite/bugs/closed/bug_4471.v create mode 100644 test-suite/bugs/closed/bug_4479.v create mode 100644 test-suite/bugs/closed/bug_4480.v create mode 100644 test-suite/bugs/closed/bug_4484.v create mode 100644 test-suite/bugs/closed/bug_4495.v create mode 100644 test-suite/bugs/closed/bug_4498.v create mode 100644 test-suite/bugs/closed/bug_4503.v create mode 100644 test-suite/bugs/closed/bug_4511.v create mode 100644 test-suite/bugs/closed/bug_4519.v create mode 100644 test-suite/bugs/closed/bug_4527.v create mode 100644 test-suite/bugs/closed/bug_4529.v create mode 100644 test-suite/bugs/closed/bug_4533.v create mode 100644 test-suite/bugs/closed/bug_4538.v create mode 100644 test-suite/bugs/closed/bug_4544.v create mode 100644 test-suite/bugs/closed/bug_4574.v create mode 100644 test-suite/bugs/closed/bug_4576.v create mode 100644 test-suite/bugs/closed/bug_4580.v create mode 100644 test-suite/bugs/closed/bug_4582.v create mode 100644 test-suite/bugs/closed/bug_4588.v create mode 100644 test-suite/bugs/closed/bug_4596.v create mode 100644 test-suite/bugs/closed/bug_4603.v create mode 100644 test-suite/bugs/closed/bug_4612.v create mode 100644 test-suite/bugs/closed/bug_4616.v create mode 100644 test-suite/bugs/closed/bug_4622.v create mode 100644 test-suite/bugs/closed/bug_4623.v create mode 100644 test-suite/bugs/closed/bug_4624.v create mode 100644 test-suite/bugs/closed/bug_4627.v create mode 100644 test-suite/bugs/closed/bug_4628.v create mode 100644 test-suite/bugs/closed/bug_4634.v create mode 100644 test-suite/bugs/closed/bug_4644.v create mode 100644 test-suite/bugs/closed/bug_4653.v create mode 100644 test-suite/bugs/closed/bug_4661.v create mode 100644 test-suite/bugs/closed/bug_4663.v create mode 100644 test-suite/bugs/closed/bug_4670.v create mode 100644 test-suite/bugs/closed/bug_4673.v create mode 100644 test-suite/bugs/closed/bug_4679.v create mode 100644 test-suite/bugs/closed/bug_4684.v create mode 100644 test-suite/bugs/closed/bug_4695.v create mode 100644 test-suite/bugs/closed/bug_4708.v create mode 100644 test-suite/bugs/closed/bug_4709.v create mode 100644 test-suite/bugs/closed/bug_4710.v create mode 100644 test-suite/bugs/closed/bug_4713.v create mode 100644 test-suite/bugs/closed/bug_4717.v create mode 100644 test-suite/bugs/closed/bug_4718.v create mode 100644 test-suite/bugs/closed/bug_4720.v create mode 100644 test-suite/bugs/closed/bug_4723.v create mode 100644 test-suite/bugs/closed/bug_4725.v create mode 100644 test-suite/bugs/closed/bug_4726.v create mode 100644 test-suite/bugs/closed/bug_4737.v create mode 100644 test-suite/bugs/closed/bug_4745.v create mode 100644 test-suite/bugs/closed/bug_4746.v create mode 100644 test-suite/bugs/closed/bug_4754.v create mode 100644 test-suite/bugs/closed/bug_4762.v create mode 100644 test-suite/bugs/closed/bug_4763.v create mode 100644 test-suite/bugs/closed/bug_4764.v create mode 100644 test-suite/bugs/closed/bug_4769.v create mode 100644 test-suite/bugs/closed/bug_4772.v create mode 100644 test-suite/bugs/closed/bug_4780.v create mode 100644 test-suite/bugs/closed/bug_4782.v create mode 100644 test-suite/bugs/closed/bug_4785.v create mode 100644 test-suite/bugs/closed/bug_4787.v create mode 100644 test-suite/bugs/closed/bug_4798.v create mode 100644 test-suite/bugs/closed/bug_4811.v create mode 100644 test-suite/bugs/closed/bug_4813.v create mode 100644 test-suite/bugs/closed/bug_4816.v create mode 100644 test-suite/bugs/closed/bug_4818.v create mode 100644 test-suite/bugs/closed/bug_4844.v create mode 100644 test-suite/bugs/closed/bug_4852.v create mode 100644 test-suite/bugs/closed/bug_4858.v create mode 100644 test-suite/bugs/closed/bug_4859.v create mode 100644 test-suite/bugs/closed/bug_4863.v create mode 100644 test-suite/bugs/closed/bug_4865.v create mode 100644 test-suite/bugs/closed/bug_4869.v create mode 100644 test-suite/bugs/closed/bug_4873.v create mode 100644 test-suite/bugs/closed/bug_4877.v create mode 100644 test-suite/bugs/closed/bug_4880.v create mode 100644 test-suite/bugs/closed/bug_4893.v create mode 100644 test-suite/bugs/closed/bug_4904.v create mode 100644 test-suite/bugs/closed/bug_4932.v create mode 100644 test-suite/bugs/closed/bug_4955.v create mode 100644 test-suite/bugs/closed/bug_4957.v create mode 100644 test-suite/bugs/closed/bug_4966.v create mode 100644 test-suite/bugs/closed/bug_4969.v create mode 100644 test-suite/bugs/closed/bug_4970.v create mode 100644 test-suite/bugs/closed/bug_5011.v create mode 100644 test-suite/bugs/closed/bug_5012.v create mode 100644 test-suite/bugs/closed/bug_5019.v create mode 100644 test-suite/bugs/closed/bug_5036.v create mode 100644 test-suite/bugs/closed/bug_5043.v create mode 100644 test-suite/bugs/closed/bug_5045.v create mode 100644 test-suite/bugs/closed/bug_5065.v create mode 100644 test-suite/bugs/closed/bug_5066.v create mode 100644 test-suite/bugs/closed/bug_5077.v create mode 100644 test-suite/bugs/closed/bug_5078.v create mode 100644 test-suite/bugs/closed/bug_5093.v create mode 100644 test-suite/bugs/closed/bug_5095.v create mode 100644 test-suite/bugs/closed/bug_5096.v create mode 100644 test-suite/bugs/closed/bug_5097.v create mode 100644 test-suite/bugs/closed/bug_5123.v create mode 100644 test-suite/bugs/closed/bug_5127.v create mode 100644 test-suite/bugs/closed/bug_5145.v create mode 100644 test-suite/bugs/closed/bug_5149.v create mode 100644 test-suite/bugs/closed/bug_5153.v create mode 100644 test-suite/bugs/closed/bug_5161.v create mode 100644 test-suite/bugs/closed/bug_5177.v create mode 100644 test-suite/bugs/closed/bug_5180.v create mode 100644 test-suite/bugs/closed/bug_5181.v create mode 100644 test-suite/bugs/closed/bug_5188.v create mode 100644 test-suite/bugs/closed/bug_5193.v create mode 100644 test-suite/bugs/closed/bug_5198.v create mode 100644 test-suite/bugs/closed/bug_5203.v create mode 100644 test-suite/bugs/closed/bug_5205.v create mode 100644 test-suite/bugs/closed/bug_5208.v create mode 100644 test-suite/bugs/closed/bug_5215.v create mode 100644 test-suite/bugs/closed/bug_5215_2.v create mode 100644 test-suite/bugs/closed/bug_5219.v create mode 100644 test-suite/bugs/closed/bug_5233.v create mode 100644 test-suite/bugs/closed/bug_5245.v create mode 100644 test-suite/bugs/closed/bug_5255.v create mode 100644 test-suite/bugs/closed/bug_5277.v create mode 100644 test-suite/bugs/closed/bug_5281.v create mode 100644 test-suite/bugs/closed/bug_5286.v create mode 100644 test-suite/bugs/closed/bug_5300.v create mode 100644 test-suite/bugs/closed/bug_5315.v create mode 100644 test-suite/bugs/closed/bug_5321.v create mode 100644 test-suite/bugs/closed/bug_5322.v create mode 100644 test-suite/bugs/closed/bug_5323.v create mode 100644 test-suite/bugs/closed/bug_5331.v create mode 100644 test-suite/bugs/closed/bug_5345.v create mode 100644 test-suite/bugs/closed/bug_5346.v create mode 100644 test-suite/bugs/closed/bug_5347.v create mode 100644 test-suite/bugs/closed/bug_5359.v create mode 100644 test-suite/bugs/closed/bug_5365.v create mode 100644 test-suite/bugs/closed/bug_5368.v create mode 100644 test-suite/bugs/closed/bug_5372.v create mode 100644 test-suite/bugs/closed/bug_5377.v create mode 100644 test-suite/bugs/closed/bug_5401.v create mode 100644 test-suite/bugs/closed/bug_5414.v create mode 100644 test-suite/bugs/closed/bug_5434.v create mode 100644 test-suite/bugs/closed/bug_5435.v create mode 100644 test-suite/bugs/closed/bug_5449.v create mode 100644 test-suite/bugs/closed/bug_5460.v create mode 100644 test-suite/bugs/closed/bug_5470.v create mode 100644 test-suite/bugs/closed/bug_5476.v create mode 100644 test-suite/bugs/closed/bug_5486.v create mode 100644 test-suite/bugs/closed/bug_5487.v create mode 100644 test-suite/bugs/closed/bug_5500.v create mode 100644 test-suite/bugs/closed/bug_5501.v create mode 100644 test-suite/bugs/closed/bug_5522.v create mode 100644 test-suite/bugs/closed/bug_5523.v create mode 100644 test-suite/bugs/closed/bug_5526.v create mode 100644 test-suite/bugs/closed/bug_5532.v create mode 100644 test-suite/bugs/closed/bug_5539.v create mode 100644 test-suite/bugs/closed/bug_5547.v create mode 100644 test-suite/bugs/closed/bug_5550.v create mode 100644 test-suite/bugs/closed/bug_5578.v create mode 100644 test-suite/bugs/closed/bug_5598.v create mode 100644 test-suite/bugs/closed/bug_5608.v create mode 100644 test-suite/bugs/closed/bug_5618.v create mode 100644 test-suite/bugs/closed/bug_5641.v create mode 100644 test-suite/bugs/closed/bug_5666.v create mode 100644 test-suite/bugs/closed/bug_5671.v create mode 100644 test-suite/bugs/closed/bug_5683.v create mode 100644 test-suite/bugs/closed/bug_5692.v create mode 100644 test-suite/bugs/closed/bug_5696.v create mode 100644 test-suite/bugs/closed/bug_5697.v create mode 100644 test-suite/bugs/closed/bug_5707.v create mode 100644 test-suite/bugs/closed/bug_5713.v create mode 100644 test-suite/bugs/closed/bug_5717.v create mode 100644 test-suite/bugs/closed/bug_5719.v create mode 100644 test-suite/bugs/closed/bug_5726.v create mode 100644 test-suite/bugs/closed/bug_5741.v create mode 100644 test-suite/bugs/closed/bug_5749.v create mode 100644 test-suite/bugs/closed/bug_5750.v create mode 100644 test-suite/bugs/closed/bug_5755.v create mode 100644 test-suite/bugs/closed/bug_5757.v create mode 100644 test-suite/bugs/closed/bug_5761.v create mode 100644 test-suite/bugs/closed/bug_5762.v create mode 100644 test-suite/bugs/closed/bug_5765.v create mode 100644 test-suite/bugs/closed/bug_5769.v create mode 100644 test-suite/bugs/closed/bug_5786.v create mode 100644 test-suite/bugs/closed/bug_5790.v create mode 100644 test-suite/bugs/closed/bug_5797.v create mode 100644 test-suite/bugs/closed/bug_5845.v create mode 100644 test-suite/bugs/closed/bug_5940.v create mode 100644 test-suite/bugs/closed/bug_6070.v create mode 100644 test-suite/bugs/closed/bug_6129.v create mode 100644 test-suite/bugs/closed/bug_6191.v create mode 100644 test-suite/bugs/closed/bug_6297.v create mode 100644 test-suite/bugs/closed/bug_6313.v create mode 100644 test-suite/bugs/closed/bug_6323.v create mode 100644 test-suite/bugs/closed/bug_6378.v create mode 100644 test-suite/bugs/closed/bug_6490.v create mode 100644 test-suite/bugs/closed/bug_6529.v create mode 100644 test-suite/bugs/closed/bug_6534.v create mode 100644 test-suite/bugs/closed/bug_6617.v create mode 100644 test-suite/bugs/closed/bug_6631.v create mode 100644 test-suite/bugs/closed/bug_6634.v create mode 100644 test-suite/bugs/closed/bug_6661.v create mode 100644 test-suite/bugs/closed/bug_6677.v create mode 100644 test-suite/bugs/closed/bug_6770.v create mode 100644 test-suite/bugs/closed/bug_6774.v create mode 100644 test-suite/bugs/closed/bug_6775.v create mode 100644 test-suite/bugs/closed/bug_6878.v create mode 100644 test-suite/bugs/closed/bug_6910.v create mode 100644 test-suite/bugs/closed/bug_6951.v create mode 100644 test-suite/bugs/closed/bug_6956.v create mode 100644 test-suite/bugs/closed/bug_7011.v create mode 100644 test-suite/bugs/closed/bug_7068.v create mode 100644 test-suite/bugs/closed/bug_7076.v create mode 100644 test-suite/bugs/closed/bug_7092.v create mode 100644 test-suite/bugs/closed/bug_7113.v create mode 100644 test-suite/bugs/closed/bug_7195.v create mode 100644 test-suite/bugs/closed/bug_7333.v create mode 100644 test-suite/bugs/closed/bug_7392.v create mode 100644 test-suite/bugs/closed/bug_7421.v create mode 100644 test-suite/bugs/closed/bug_7462.v create mode 100644 test-suite/bugs/closed/bug_7554.v create mode 100644 test-suite/bugs/closed/bug_7615.v create mode 100644 test-suite/bugs/closed/bug_7631.v create mode 100644 test-suite/bugs/closed/bug_7695.v create mode 100644 test-suite/bugs/closed/bug_7700.v create mode 100644 test-suite/bugs/closed/bug_7712.v create mode 100644 test-suite/bugs/closed/bug_7723.v create mode 100644 test-suite/bugs/closed/bug_7754.v create mode 100644 test-suite/bugs/closed/bug_7779.v create mode 100644 test-suite/bugs/closed/bug_7780.v create mode 100644 test-suite/bugs/closed/bug_7795.v create mode 100644 test-suite/bugs/closed/bug_7811.v create mode 100644 test-suite/bugs/closed/bug_7854.v create mode 100644 test-suite/bugs/closed/bug_7867.v create mode 100644 test-suite/bugs/closed/bug_7900.v create mode 100644 test-suite/bugs/closed/bug_7903.v create mode 100644 test-suite/bugs/closed/bug_7967.v create mode 100644 test-suite/bugs/closed/bug_8004.v create mode 100644 test-suite/bugs/closed/bug_8081.v create mode 100644 test-suite/bugs/closed/bug_808_2411.v create mode 100644 test-suite/bugs/closed/bug_8106.v create mode 100644 test-suite/bugs/closed/bug_8119.v create mode 100644 test-suite/bugs/closed/bug_8121.v create mode 100644 test-suite/bugs/closed/bug_8126.v create mode 100644 test-suite/bugs/closed/bug_8215.v create mode 100644 test-suite/bugs/closed/bug_8270.v create mode 100644 test-suite/bugs/closed/bug_8288.v create mode 100644 test-suite/bugs/closed/bug_8432.v create mode 100644 test-suite/bugs/closed/bug_8478.v create mode 100644 test-suite/bugs/closed/bug_8532.v delete mode 100644 test-suite/bugs/opened/1338.v-disabled delete mode 100644 test-suite/bugs/opened/1596.v delete mode 100644 test-suite/bugs/opened/1615.v delete mode 100644 test-suite/bugs/opened/1671.v delete mode 100644 test-suite/bugs/opened/1811.v delete mode 100644 test-suite/bugs/opened/2572.v-disabled delete mode 100644 test-suite/bugs/opened/3010.v-disabled delete mode 100644 test-suite/bugs/opened/3092.v delete mode 100644 test-suite/bugs/opened/3166.v delete mode 100644 test-suite/bugs/opened/3186.v-disabled delete mode 100644 test-suite/bugs/opened/3248.v delete mode 100644 test-suite/bugs/opened/3277.v delete mode 100644 test-suite/bugs/opened/3278.v delete mode 100644 test-suite/bugs/opened/3283.v delete mode 100644 test-suite/bugs/opened/3295.v delete mode 100644 test-suite/bugs/opened/3304.v delete mode 100644 test-suite/bugs/opened/3311.v delete mode 100644 test-suite/bugs/opened/3312.v delete mode 100644 test-suite/bugs/opened/3343.v delete mode 100644 test-suite/bugs/opened/3345.v delete mode 100644 test-suite/bugs/opened/3357.v delete mode 100644 test-suite/bugs/opened/3363.v delete mode 100644 test-suite/bugs/opened/3370.v delete mode 100644 test-suite/bugs/opened/3395.v delete mode 100644 test-suite/bugs/opened/3424.v delete mode 100644 test-suite/bugs/opened/3459.v delete mode 100644 test-suite/bugs/opened/3463.v delete mode 100644 test-suite/bugs/opened/3478.v-disabled delete mode 100644 test-suite/bugs/opened/3626.v delete mode 100644 test-suite/bugs/opened/3655.v delete mode 100644 test-suite/bugs/opened/3754.v delete mode 100644 test-suite/bugs/opened/3794.v delete mode 100644 test-suite/bugs/opened/3889.v delete mode 100644 test-suite/bugs/opened/3890.v delete mode 100644 test-suite/bugs/opened/3919.v-disabled delete mode 100644 test-suite/bugs/opened/3922.v-disabled delete mode 100644 test-suite/bugs/opened/3928.v-disabled delete mode 100644 test-suite/bugs/opened/3938.v delete mode 100644 test-suite/bugs/opened/3946.v delete mode 100644 test-suite/bugs/opened/4701.v delete mode 100644 test-suite/bugs/opened/4721.v delete mode 100644 test-suite/bugs/opened/4728.v delete mode 100644 test-suite/bugs/opened/4755.v delete mode 100644 test-suite/bugs/opened/4771.v delete mode 100644 test-suite/bugs/opened/4778.v delete mode 100644 test-suite/bugs/opened/4781.v delete mode 100644 test-suite/bugs/opened/4813.v delete mode 100644 test-suite/bugs/opened/6393.v delete mode 100644 test-suite/bugs/opened/6602.v create mode 100644 test-suite/bugs/opened/bug_1338.v-disabled create mode 100644 test-suite/bugs/opened/bug_1596.v create mode 100644 test-suite/bugs/opened/bug_1615.v create mode 100644 test-suite/bugs/opened/bug_1671.v create mode 100644 test-suite/bugs/opened/bug_1811.v create mode 100644 test-suite/bugs/opened/bug_2572.v-disabled create mode 100644 test-suite/bugs/opened/bug_3010.v-disabled create mode 100644 test-suite/bugs/opened/bug_3092.v create mode 100644 test-suite/bugs/opened/bug_3166.v create mode 100644 test-suite/bugs/opened/bug_3186.v-disabled create mode 100644 test-suite/bugs/opened/bug_3248.v create mode 100644 test-suite/bugs/opened/bug_3277.v create mode 100644 test-suite/bugs/opened/bug_3278.v create mode 100644 test-suite/bugs/opened/bug_3283.v create mode 100644 test-suite/bugs/opened/bug_3295.v create mode 100644 test-suite/bugs/opened/bug_3304.v create mode 100644 test-suite/bugs/opened/bug_3311.v create mode 100644 test-suite/bugs/opened/bug_3312.v create mode 100644 test-suite/bugs/opened/bug_3343.v create mode 100644 test-suite/bugs/opened/bug_3345.v create mode 100644 test-suite/bugs/opened/bug_3357.v create mode 100644 test-suite/bugs/opened/bug_3363.v create mode 100644 test-suite/bugs/opened/bug_3370.v create mode 100644 test-suite/bugs/opened/bug_3395.v create mode 100644 test-suite/bugs/opened/bug_3424.v create mode 100644 test-suite/bugs/opened/bug_3459.v create mode 100644 test-suite/bugs/opened/bug_3463.v create mode 100644 test-suite/bugs/opened/bug_3478.v-disabled create mode 100644 test-suite/bugs/opened/bug_3626.v create mode 100644 test-suite/bugs/opened/bug_3655.v create mode 100644 test-suite/bugs/opened/bug_3754.v create mode 100644 test-suite/bugs/opened/bug_3794.v create mode 100644 test-suite/bugs/opened/bug_3889.v create mode 100644 test-suite/bugs/opened/bug_3890.v create mode 100644 test-suite/bugs/opened/bug_3919.v-disabled create mode 100644 test-suite/bugs/opened/bug_3922.v-disabled create mode 100644 test-suite/bugs/opened/bug_3928.v-disabled create mode 100644 test-suite/bugs/opened/bug_3938.v create mode 100644 test-suite/bugs/opened/bug_3946.v create mode 100644 test-suite/bugs/opened/bug_4701.v create mode 100644 test-suite/bugs/opened/bug_4721.v create mode 100644 test-suite/bugs/opened/bug_4728.v create mode 100644 test-suite/bugs/opened/bug_4755.v create mode 100644 test-suite/bugs/opened/bug_4771.v create mode 100644 test-suite/bugs/opened/bug_4778.v create mode 100644 test-suite/bugs/opened/bug_4781.v create mode 100644 test-suite/bugs/opened/bug_4813.v create mode 100644 test-suite/bugs/opened/bug_6393.v create mode 100644 test-suite/bugs/opened/bug_6602.v delete mode 100644 test-suite/interactive/4289.v create mode 100644 test-suite/interactive/bug_4289.v diff --git a/dev/tools/update-compat.py b/dev/tools/update-compat.py index 7c8b9f025c..14094553a2 100755 --- a/dev/tools/update-compat.py +++ b/dev/tools/update-compat.py @@ -17,7 +17,7 @@ FLAGS_ML_PATH = os.path.join(ROOT_PATH, 'lib', 'flags.ml') COQARGS_ML_PATH = os.path.join(ROOT_PATH, 'toplevel', 'coqargs.ml') G_VERNAC_PATH = os.path.join(ROOT_PATH, 'vernac', 'g_vernac.mlg') DOC_INDEX_PATH = os.path.join(ROOT_PATH, 'doc', 'stdlib', 'index-list.html.template') -BUG_4798_PATH = os.path.join(ROOT_PATH, 'test-suite', 'bugs', 'closed', '4798.v') +BUG_4798_PATH = os.path.join(ROOT_PATH, 'test-suite', 'bugs', 'closed', 'bug_4798.v') TEST_SUITE_PATHS = tuple(os.path.join(ROOT_PATH, 'test-suite', 'success', i) for i in ('CompatOldOldFlag.v', 'CompatOldFlag.v', 'CompatPreviousFlag.v', 'CompatCurrentFlag.v')) TEST_SUITE_DESCRIPTIONS = ('current-minus-three', 'current-minus-two', 'current-minus-one', 'current') diff --git a/test-suite/bugs/5996.v b/test-suite/bugs/5996.v deleted file mode 100644 index c9e3292b48..0000000000 --- a/test-suite/bugs/5996.v +++ /dev/null @@ -1,8 +0,0 @@ -Goal Type. - let c := constr:(prod nat nat) in - let c' := (eval pattern nat in c) in - let c' := lazymatch c' with ?f _ => f end in - let c'' := lazymatch c' with fun x : Set => ?f => constr:(forall x : Type, f) end in - let _ := type of c'' in - exact c''. -Defined. diff --git a/test-suite/bugs/bug_5996.v b/test-suite/bugs/bug_5996.v new file mode 100644 index 0000000000..c9e3292b48 --- /dev/null +++ b/test-suite/bugs/bug_5996.v @@ -0,0 +1,8 @@ +Goal Type. + let c := constr:(prod nat nat) in + let c' := (eval pattern nat in c) in + let c' := lazymatch c' with ?f _ => f end in + let c'' := lazymatch c' with fun x : Set => ?f => constr:(forall x : Type, f) end in + let _ := type of c'' in + exact c''. +Defined. diff --git a/test-suite/bugs/closed/1238.v b/test-suite/bugs/closed/1238.v deleted file mode 100644 index 6b6e83779f..0000000000 --- a/test-suite/bugs/closed/1238.v +++ /dev/null @@ -1,22 +0,0 @@ -Require Import Setoid. - -Variable A : Set. - -Inductive liste : Set := -| vide : liste -| c : A -> liste -> liste. - -Inductive e : A -> liste -> Prop := -| ec : forall (x : A) (l : liste), e x (c x l) -| ee : forall (x y : A) (l : liste), e x l -> e x (c y l). - -Definition same := fun (l m : liste) => forall (x : A), e x l <-> e x m. - -Definition same_refl (x:liste) : (same x x). - unfold same; split; intros; trivial. -Qed. - -Goal forall (x:liste), (same x x). - intro. - apply (same_refl x). -Qed. diff --git a/test-suite/bugs/closed/1243.v b/test-suite/bugs/closed/1243.v deleted file mode 100644 index 7d6781db27..0000000000 --- a/test-suite/bugs/closed/1243.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import ZArith. -Require Import Arith. -Open Scope Z_scope. - -Theorem r_ex : (forall x y:nat, x + y = x + y)%nat. -Admitted. - -Theorem r_ex' : forall x y:nat, (x + y = x + y)%nat. -Admitted. - - - diff --git a/test-suite/bugs/closed/1302.v b/test-suite/bugs/closed/1302.v deleted file mode 100644 index e94dfcfb05..0000000000 --- a/test-suite/bugs/closed/1302.v +++ /dev/null @@ -1,22 +0,0 @@ -Module Type T. - -Parameter A : Type. - -Inductive L : Type := -| L0 : L (* without this constructor, it works right *) -| L1 : A -> L. - -End T. - -Axiom Tp : Type. - -Module TT : T. - -Definition A : Type := Tp. - -Inductive L : Type := -| L0 : L -| L1 : A -> L. - -End TT. - diff --git a/test-suite/bugs/closed/1322.v b/test-suite/bugs/closed/1322.v deleted file mode 100644 index 6941ade44c..0000000000 --- a/test-suite/bugs/closed/1322.v +++ /dev/null @@ -1,28 +0,0 @@ -Require Import Setoid. - -Section transition_gen. - -Variable I : Type. -Variable I_eq :I -> I -> Prop. -Variable I_eq_equiv : Setoid_Theory I I_eq. - -(* Add Relation I I_eq - reflexivity proved by I_eq_equiv.(Seq_refl I I_eq) - symmetry proved by I_eq_equiv.(Seq_sym I I_eq) - transitivity proved by I_eq_equiv.(Seq_trans I I_eq) -as I_eq_relation. *) - -Add Parametric Relation : I I_eq - reflexivity proved by I_eq_equiv.(@Equivalence_Reflexive _ _) - symmetry proved by I_eq_equiv.(@Equivalence_Symmetric _ _) - transitivity proved by I_eq_equiv.(@Equivalence_Transitive _ _) - as I_with_eq. - -Variable F : I -> Type. -Variable F_morphism : forall i j, I_eq i j -> F i = F j. - - -Add Morphism F with signature I_eq ==> (@eq _) as F_morphism2. -Admitted. - -End transition_gen. diff --git a/test-suite/bugs/closed/1341.v b/test-suite/bugs/closed/1341.v deleted file mode 100644 index 79a0a14d7c..0000000000 --- a/test-suite/bugs/closed/1341.v +++ /dev/null @@ -1,17 +0,0 @@ -Require Import Setoid. - -Section Setoid_Bug. - -Variable X:Type -> Type. -Variable Xeq : forall A, (X A) -> (X A) -> Prop. -Hypothesis Xst : forall A, Equivalence (Xeq A). - -Variable map : forall A B, (A -> B) -> X A -> X B. - -Arguments map [A B]. - -Goal forall A B (a b:X (B -> A)) (c:X A) (f:A -> B -> A), Xeq _ a b -> Xeq _ b (map f c) -> Xeq _ a (map f c). -intros A B a b c f Hab Hbc. -rewrite Hab. -assumption. -Qed. diff --git a/test-suite/bugs/closed/1362.v b/test-suite/bugs/closed/1362.v deleted file mode 100644 index 6cafb9f0cd..0000000000 --- a/test-suite/bugs/closed/1362.v +++ /dev/null @@ -1,26 +0,0 @@ -(** Omega is now aware of the bodies of context variables - (of type Z or nat). *) - -Require Import ZArith Omega. -Open Scope Z. - -Goal let x := 3 in x = 3. -intros. -omega. -Qed. - -Open Scope nat. - -Goal let x := 2 in x = 2. -intros. -omega. -Qed. - -(** NB: this could be disabled for compatibility reasons *) - -Unset Omega UseLocalDefs. - -Goal let x := 4 in x = 4. -intros. -Fail omega. -Abort. diff --git a/test-suite/bugs/closed/1411.v b/test-suite/bugs/closed/1411.v deleted file mode 100644 index a1a7b288a5..0000000000 --- a/test-suite/bugs/closed/1411.v +++ /dev/null @@ -1,35 +0,0 @@ -Require Import List. -Require Import Program. - -Inductive Tree : Set := -| Br : Tree -> Tree -> Tree -| No : nat -> Tree -. - -(* given a tree, we want to know which lists can - be used to navigate exactly to a node *) -Inductive Exact : Tree -> list bool -> Prop := -| exDone n : Exact (No n) nil -| exLeft l r p: Exact l p -> Exact (Br l r) (true::p) -| exRight l r p: Exact r p -> Exact (Br l r) (false::p) -. - -Definition unreachable A : False -> A. -intros. -destruct H. -Defined. - -Program Fixpoint fetch t p (x:Exact t p) {struct t} := - match t, p with - | No p' , nil => p' - | No p' , _::_ => unreachable nat _ - | Br l r, nil => unreachable nat _ - | Br l r, true::t => fetch l t _ - | Br l r, false::t => fetch r t _ - end. - -Next Obligation. inversion x. Qed. -Next Obligation. inversion x. Qed. -Next Obligation. inversion x; trivial. Qed. -Next Obligation. inversion x; trivial. Qed. - diff --git a/test-suite/bugs/closed/1414.v b/test-suite/bugs/closed/1414.v deleted file mode 100644 index ee9e2504a6..0000000000 --- a/test-suite/bugs/closed/1414.v +++ /dev/null @@ -1,40 +0,0 @@ -Require Import ZArith Coq.Program.Wf Coq.Program.Utils. - -Parameter data:Set. - -Inductive t : Set := - | Leaf : t - | Node : t -> data -> t -> Z -> t. - -Parameter avl : t -> Prop. -Parameter bst : t -> Prop. -Parameter In : data -> t -> Prop. -Parameter cardinal : t -> nat. -Definition card2 (s:t*t) := let (s1,s2) := s in cardinal s1 + cardinal s2. - -Parameter split : data -> t -> t*(bool*t). -Parameter join : t -> data -> t -> t. -Parameter add : data -> t -> t. - -Program Fixpoint union - (s u:t) - (hb1: bst s)(ha1: avl s)(hb2: bst u)(hb2: avl u) - { measure (cardinal s + cardinal u) } : - {s' : t | bst s' /\ avl s' /\ forall x, In x s' <-> In x s \/ In x u} := - match s, u with - | Leaf,t2 => t2 - | t1,Leaf => t1 - | Node l1 v1 r1 h1, Node l2 v2 r2 h2 => - if (Z_ge_lt_dec h1 h2) then - if (Z.eq_dec h2 1) - then add v2 s - else - let (l2', r2') := split v1 u in - join (union l1 l2' _ _ _ _) v1 (union r1 (snd r2') _ _ _ _) - else - if (Z.eq_dec h1 1) - then add v1 s - else - let (l1', r1') := split v2 u in - join (union l1' l2 _ _ _ _) v2 (union (snd r1') r2 _ _ _ _) - end. diff --git a/test-suite/bugs/closed/1416.v b/test-suite/bugs/closed/1416.v deleted file mode 100644 index ee09200573..0000000000 --- a/test-suite/bugs/closed/1416.v +++ /dev/null @@ -1,30 +0,0 @@ -(* In 8.1 autorewrite used to raised an anomaly here *) -(* After resolution of the bug, autorewrite succeeded *) -(* From forthcoming 8.4, autorewrite is forbidden to instantiate *) -(* evars, so the new test just checks it is not an anomaly *) - -Set Implicit Arguments. - -Record Place (Env A: Type) : Type := { - read: Env -> A ; - write: Env -> A -> Env ; - write_read: forall (e:Env), (write e (read e))=e -}. - -Hint Rewrite -> write_read: placeeq. - -Record sumPl (Env A B: Type) (vL:(Place Env A)) (vR:(Place Env B)) : Type := - { - mkEnv: A -> B -> Env ; - mkEnv2writeL: forall (e:Env) (x:A), (mkEnv x (read vR e))=(write vL e x) - }. - -(* when the following line is commented, the bug does not appear *) -Hint Rewrite -> mkEnv2writeL: placeeq. - -Lemma autorewrite_raise_anomaly: forall (Env A:Type) (e: Env) (p:Place Env A), - (exists e1:Env, e=(write p e1 (read p e))). -Proof. - intros Env A e p; eapply ex_intro. - autorewrite with placeeq. (* Here is the bug *) - diff --git a/test-suite/bugs/closed/1419.v b/test-suite/bugs/closed/1419.v deleted file mode 100644 index d021107d1d..0000000000 --- a/test-suite/bugs/closed/1419.v +++ /dev/null @@ -1,8 +0,0 @@ -Goal True. - set(a := 0). - set(b := a). - unfold a in b. - clear a. - Eval vm_compute in b. - trivial. -Qed. diff --git a/test-suite/bugs/closed/1425.v b/test-suite/bugs/closed/1425.v deleted file mode 100644 index 775d278e74..0000000000 --- a/test-suite/bugs/closed/1425.v +++ /dev/null @@ -1,19 +0,0 @@ -Require Import Setoid. - -Parameter recursion : forall A : Set, A -> (nat -> A -> A) -> nat -> A. - -Axiom recursion_S : - forall (A : Set) (EA : relation A) (a : A) (f : nat -> A -> A) (n : nat), - EA (recursion A a f (S n)) (f n (recursion A a f n)). - -Goal forall n : nat, recursion nat 0 (fun _ _ => 1) (S n) = 1. -intro n. -rewrite recursion_S. -reflexivity. -Qed. - -Goal forall n : nat, recursion nat 0 (fun _ _ => 1) (S n) = 1. -intro n. -setoid_rewrite recursion_S. -reflexivity. -Qed. diff --git a/test-suite/bugs/closed/1446.v b/test-suite/bugs/closed/1446.v deleted file mode 100644 index 8cb2d653b6..0000000000 --- a/test-suite/bugs/closed/1446.v +++ /dev/null @@ -1,20 +0,0 @@ -Lemma not_true_eq_false : forall (b:bool), b <> true -> b = false. -Proof. - destruct b;intros;trivial. - elim H. - exact (refl_equal true). -Qed. - -Section BUG. - - Variable b : bool. - Hypothesis H : b <> true. - Hypothesis H0 : b = true. - Hypothesis H1 : b <> true. - - Goal False. - rewrite (not_true_eq_false _ H) in * |-. - contradiction. - Qed. - -End BUG. diff --git a/test-suite/bugs/closed/1448.v b/test-suite/bugs/closed/1448.v deleted file mode 100644 index fe3b4c8b41..0000000000 --- a/test-suite/bugs/closed/1448.v +++ /dev/null @@ -1,28 +0,0 @@ -Require Import Relations. -Require Import Setoid. -Require Import Ring_theory. -Require Import Ring_base. - - -Variable R : Type. -Variable Rone Rzero : R. -Variable Rplus Rmult Rminus : R -> R -> R. -Variable Rneg : R -> R. - -Lemma my_ring_theory : @ring_theory R Rzero Rone Rplus Rmult Rminus Rneg (@eq -R). -Admitted. - -Variable Req : R -> R -> Prop. - -Hypothesis Req_refl : reflexive _ Req. -Hypothesis Req_sym : symmetric _ Req. -Hypothesis Req_trans : transitive _ Req. - -Add Relation R Req - reflexivity proved by Req_refl - symmetry proved by Req_sym - transitivity proved by Req_trans - as Req_rel. - -Add Ring my_ring : my_ring_theory (abstract). diff --git a/test-suite/bugs/closed/1477.v b/test-suite/bugs/closed/1477.v deleted file mode 100644 index dfc8c32806..0000000000 --- a/test-suite/bugs/closed/1477.v +++ /dev/null @@ -1,18 +0,0 @@ -Inductive I : Set := - | A : nat -> nat -> I - | B : nat -> nat -> I. - -Definition foo1 (x:I) : nat := - match x with - | A a b | B a b => S b - end. - -Definition foo2 (x:I) : nat := - match x with - | A _ b | B b _ => S b - end. - -Definition foo (x:I) : nat := - match x with - | A a b | B b a => S b - end. diff --git a/test-suite/bugs/closed/1483.v b/test-suite/bugs/closed/1483.v deleted file mode 100644 index a3d7f16830..0000000000 --- a/test-suite/bugs/closed/1483.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import BinPos. - -Definition P := (fun x : positive => x = xH). - -Goal forall (p q : positive), P q -> q = p -> P p. -intros; congruence. -Qed. - - - diff --git a/test-suite/bugs/closed/1501.v b/test-suite/bugs/closed/1501.v deleted file mode 100644 index e771e192dc..0000000000 --- a/test-suite/bugs/closed/1501.v +++ /dev/null @@ -1,67 +0,0 @@ -Set Implicit Arguments. - - -Require Export Relation_Definitions. -Require Export Setoid. -Require Import Morphisms. - - -Section Essais. - -(* Parametrized Setoid *) -Parameter K : Type -> Type. -Parameter equiv : forall A : Type, K A -> K A -> Prop. -Parameter equiv_refl : forall (A : Type) (x : K A), equiv x x. -Parameter equiv_sym : forall (A : Type) (x y : K A), equiv x y -> equiv y x. -Parameter equiv_trans : forall (A : Type) (x y z : K A), equiv x y -> equiv y z --> equiv x z. - -(* basic operations *) -Parameter val : forall A : Type, A -> K A. -Parameter bind : forall A B : Type, K A -> (A -> K B) -> K B. - -Parameter - bind_compat : - forall (A B : Type) (m1 m2 : K A) (f1 f2 : A -> K B), - equiv m1 m2 -> - (forall x : A, equiv (f1 x) (f2 x)) -> equiv (bind m1 f1) (bind m2 f2). - -(* monad axioms *) -Parameter - bind_val_l : - forall (A B : Type) (a : A) (f : A -> K B), equiv (bind (val a) f) (f a). -Parameter - bind_val_r : - forall (A : Type) (m : K A), equiv (bind m (fun a => val a)) m. -Parameter - bind_assoc : - forall (A B C : Type) (m : K A) (f : A -> K B) (g : B -> K C), - equiv (bind (bind m f) g) (bind m (fun a => bind (f a) g)). - - -Hint Resolve equiv_refl equiv_sym equiv_trans: monad. - -Add Parametric Relation A : (K A) (@equiv A) - reflexivity proved by (@equiv_refl A) - symmetry proved by (@equiv_sym A) - transitivity proved by (@equiv_trans A) - as equiv_rel. - -Add Parametric Morphism A B : (@bind A B) - with signature (@equiv A) ==> (pointwise_relation A (@equiv B)) ==> (@equiv B) - as bind_mor. -Proof. - unfold pointwise_relation; intros; apply bind_compat; auto. -Qed. - -Lemma test: - forall (A B: Type) (m1 m2 m3: K A) (f: A -> A -> K B), - (equiv m1 m2) -> (equiv m2 m3) -> - equiv (bind m1 (fun a => bind m2 (fun a' => f a a'))) - (bind m2 (fun a => bind m3 (fun a' => f a a'))). -Proof. - intros A B m1 m2 m3 f H1 H2. - setoid_rewrite H1. (* this works *) - setoid_rewrite H2. - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/1507.v b/test-suite/bugs/closed/1507.v deleted file mode 100644 index f2ab910034..0000000000 --- a/test-suite/bugs/closed/1507.v +++ /dev/null @@ -1,120 +0,0 @@ -(* - Implementing reals a la Stolzenberg - - Danko Ilik, March 2007 - - XField.v -- (unfinished) axiomatisation of the theories of real and - rational intervals. -*) - -Definition associative (A:Type)(op:A->A->A) := - forall x y z:A, op (op x y) z = op x (op y z). - -Definition commutative (A:Type)(op:A->A->A) := - forall x y:A, op x y = op y x. - -Definition trichotomous (A:Type)(R:A->A->Prop) := - forall x y:A, R x y \/ x=y \/ R y x. - -Definition relation (A:Type) := A -> A -> Prop. -Definition reflexive (A:Type)(R:relation A) := forall x:A, R x x. -Definition transitive (A:Type)(R:relation A) := - forall x y z:A, R x y -> R y z -> R x z. -Definition symmetric (A:Type)(R:relation A) := forall x y:A, R x y -> R y x. - -Record interval (X:Set)(le:X->X->Prop) : Set := - interval_make { - interval_left : X; - interval_right : X; - interval_nonempty : le interval_left interval_right - }. - -Record I (grnd:Set)(le:grnd->grnd->Prop) : Type := Imake { - Icar := interval grnd le; - Iplus : Icar -> Icar -> Icar; - Imult : Icar -> Icar -> Icar; - Izero : Icar; - Ione : Icar; - Iopp : Icar -> Icar; - Iinv : Icar -> Icar; - Ic : Icar -> Icar -> Prop; (* consistency *) - (* monoids *) - Iplus_assoc : associative Icar Iplus; - Imult_assoc : associative Icar Imult; - (* abelian groups *) - Iplus_comm : commutative Icar Iplus; - Imult_comm : commutative Icar Imult; - Iplus_0_l : forall x:Icar, Ic (Iplus Izero x) x; - Iplus_0_r : forall x:Icar, Ic (Iplus x Izero) x; - Imult_0_l : forall x:Icar, Ic (Imult Ione x) x; - Imult_0_r : forall x:Icar, Ic (Imult x Ione) x; - Iplus_opp_r : forall x:Icar, Ic (Iplus x (Iopp x)) (Izero); - Imult_inv_r : forall x:Icar, ~(Ic x Izero) -> Ic (Imult x (Iinv x)) Ione; - (* distributive laws *) - Imult_plus_distr_l : forall x x' y y' z z' z'', - Ic x x' -> Ic y y' -> Ic z z' -> Ic z z'' -> - Ic (Imult (Iplus x y) z) (Iplus (Imult x' z') (Imult y' z'')); - (* order and lattice structure *) - Ilt : Icar -> Icar -> Prop; - Ilc := fun (x y:Icar) => Ilt x y \/ Ic x y; - Isup : Icar -> Icar -> Icar; - Iinf : Icar -> Icar -> Icar; - Ilt_trans : transitive _ lt; - Ilt_trich : forall x y:Icar, Ilt x y \/ Ic x y \/ Ilt y x; - Isup_lub : forall x y z:Icar, Ilc x z -> Ilc y z -> Ilc (Isup x y) z; - Iinf_glb : forall x y z:Icar, Ilc x y -> Ilc x z -> Ilc x (Iinf y z); - (* order preserves operations? *) - (* properties of Ic *) - Ic_refl : reflexive _ Ic; - Ic_sym : symmetric _ Ic -}. - -Definition interval_set (X:Set)(le:X->X->Prop) := - (interval X le) -> Prop. (* can be Set as well *) -Check interval_set. -Check Ic. -Definition consistent (X:Set)(le:X->X->Prop)(TI:I X le)(p:interval_set X le) := - forall I J:interval X le, p I -> p J -> (Ic X le TI) I J. -Check consistent. -(* define 'fine' *) - -Record N (grnd:Set)(le:grnd->grnd->Prop)(grndI:I grnd le) : Type := Nmake { - Ncar := interval_set grnd le; - Nplus : Ncar -> Ncar -> Ncar; - Nmult : Ncar -> Ncar -> Ncar; - Nzero : Ncar; - None : Ncar; - Nopp : Ncar -> Ncar; - Ninv : Ncar -> Ncar; - Nc : Ncar -> Ncar -> Prop; (* Ncistency *) - (* monoids *) - Nplus_assoc : associative Ncar Nplus; - Nmult_assoc : associative Ncar Nmult; - (* abelian groups *) - Nplus_comm : commutative Ncar Nplus; - Nmult_comm : commutative Ncar Nmult; - Nplus_0_l : forall x:Ncar, Nc (Nplus Nzero x) x; - Nplus_0_r : forall x:Ncar, Nc (Nplus x Nzero) x; - Nmult_0_l : forall x:Ncar, Nc (Nmult None x) x; - Nmult_0_r : forall x:Ncar, Nc (Nmult x None) x; - Nplus_opp_r : forall x:Ncar, Nc (Nplus x (Nopp x)) (Nzero); - Nmult_inv_r : forall x:Ncar, ~(Nc x Nzero) -> Nc (Nmult x (Ninv x)) None; - (* distributive laws *) - Nmult_plus_distr_l : forall x x' y y' z z' z'', - Nc x x' -> Nc y y' -> Nc z z' -> Nc z z'' -> - Nc (Nmult (Nplus x y) z) (Nplus (Nmult x' z') (Nmult y' z'')); - (* order and lattice structure *) - Nlt : Ncar -> Ncar -> Prop; - Nlc := fun (x y:Ncar) => Nlt x y \/ Nc x y; - Nsup : Ncar -> Ncar -> Ncar; - Ninf : Ncar -> Ncar -> Ncar; - Nlt_trans : transitive _ lt; - Nlt_trich : forall x y:Ncar, Nlt x y \/ Nc x y \/ Nlt y x; - Nsup_lub : forall x y z:Ncar, Nlc x z -> Nlc y z -> Nlc (Nsup x y) z; - Ninf_glb : forall x y z:Ncar, Nlc x y -> Nlc x z -> Nlc x (Ninf y z); - (* order preserves operations? *) - (* properties of Nc *) - Nc_refl : reflexive _ Nc; - Nc_sym : symmetric _ Nc -}. - diff --git a/test-suite/bugs/closed/1519.v b/test-suite/bugs/closed/1519.v deleted file mode 100644 index de60de59e9..0000000000 --- a/test-suite/bugs/closed/1519.v +++ /dev/null @@ -1,23 +0,0 @@ -Section S. - - Variable A:Prop. - Variable W:A. - - Remark T: A -> A. - intro Z. - rename W into Z_. - rename Z into W. - rename Z_ into Z. - exact Z. - Qed. - - (* bug : - Error: - Unbound reference: In environment - A : Prop - W : A - Z : A - The reference 2 is free - *) - -End S. diff --git a/test-suite/bugs/closed/1542.v b/test-suite/bugs/closed/1542.v deleted file mode 100644 index 52cfbbc496..0000000000 --- a/test-suite/bugs/closed/1542.v +++ /dev/null @@ -1,40 +0,0 @@ -Module Type TITI. -Parameter B:Set. -Parameter x:B. -Inductive A:Set:= -a1:B->A. -Definition f2: A ->B -:= fun (a:A) => -match a with - (a1 b)=>b -end. -Definition f: A -> B:=fun (a:A) => x. -End TITI. - - -Module Type TIT. -Declare Module t:TITI. -End TIT. - -Module Seq(titi:TIT). -Module t:=titi.t. -Inductive toto:t.A->t.B->Set:= -t1:forall (a:t.A), (toto a (t.f a)) -| t2:forall (a:t.A), (toto a (t.f2 a)). -End Seq. - -Module koko(tit:TIT). -Module seq:=Seq tit. -Module t':=tit.t. - -Definition def:forall (a:t'.A), (seq.toto a (t'.f a)). -intro ; constructor 1. -Defined. - -Definition def2: forall (a:t'.A), (seq.toto a (t'.f2 a)). -intro; constructor 2. -(* Toplevel input, characters 0-13 - constructor 2. - ^^^^^^^^^^^^^ -Error: Impossible to unify (seq.toto ?3 (seq.t.f2 ?3)) with - (seq.toto a (t'.f2 a)).*) diff --git a/test-suite/bugs/closed/1543.v b/test-suite/bugs/closed/1543.v deleted file mode 100644 index def6ed98dd..0000000000 --- a/test-suite/bugs/closed/1543.v +++ /dev/null @@ -1,100 +0,0 @@ -Module Sylvain_Boulme. -Module Type Essai. -Parameter T: Type. -Parameter my_eq: T -> T -> Prop. -Parameter my_eq_refl: forall (x:T), (my_eq x x). -Parameter c: T. -End Essai. - -Module Type Essai2. -Declare Module M: Essai. -Parameter c2: M.T. -End Essai2. - -Module Type Essai3. -Declare Module M: Essai. -Parameter c3: M.T. -End Essai3. - -Module Type Lift. -Declare Module Core: Essai. -Declare Module M: Essai. -Parameter lift: Core.T -> M.T. -Parameter lift_prop:forall (x:Core.T), (Core.my_eq x Core.c)->(M.my_eq (lift x) M.c). -End Lift. - -Module I2 (X:Essai) <: Essai2. - Module Core := X. - Module M<:Essai. - Definition T:Type :=Prop. - Definition my_eq:=(@eq Prop). - Definition c:=True. - Lemma my_eq_refl: forall (x:T), (my_eq x x). - Proof. - unfold my_eq; auto. - Qed. - End M. - Definition c2:=False. - Definition lift:=fun (_:Core.T) => M.c. - Definition lift_prop: forall (x:Core.T), (Core.my_eq x Core.c)->(M.my_eq (lift x) M.c). - Proof. - unfold lift, M.my_eq; auto. - Qed. -End I2. - -Module I4(X:Essai3) (L: Lift with Module Core := X.M) <: Essai3 with Module -M:=L.M. - Module M:=L.M. - Definition c3:=(L.lift X.c3). -End I4. - -Module I5(X:Essai3). - Module Toto<: Lift with Module Core := X.M := I2(X.M). - Module E4<: Essai3 with Module M:=Toto.M := I4(X)(Toto). -(* -Le typage de E4 echoue avec le message - Error: Signature components for label my_eq_refl do not match - *) - - Module E3<: Essai3 := I4(X)(Toto). - - Definition zarb: forall (x:Toto.M.T), (Toto.M.my_eq x x) := E3.M.my_eq_refl. -End I5. -End Sylvain_Boulme. - - -Module Jacek. - - Module Type SIG. - End SIG. - Module N. - Definition A:=Set. - End N. - Module Type SIG2. - Declare Module M:SIG. - Parameter B:Type. - End SIG2. - Module F(X:SIG2 with Module M:=N) (Y:SIG2 with Definition B:=X.M.A). - End F. -End Jacek. - - -Module anoun. - Module Type TITI. - Parameter X: Set. - End TITI. - - Module Type Ex. - Declare Module t: TITI. - Parameter X : t.X -> t.X -> Set. - End Ex. - - Module unionEx(X1: Ex) (X2:Ex with Module t :=X1.t): Ex. - Module t:=X1.t. - Definition X :=fun (a b:t.X) => ((X1.X a b)+(X2.X a b))%type. - End unionEx. -End anoun. -(* Le warning qui s'affiche lors de la compilation est le suivant : - TODO:replace module after with! - Est ce qu'il y'a qq1 qui pourrait m'aider à comprendre le probleme?! - Je vous remercie d'avance *) diff --git a/test-suite/bugs/closed/1545.v b/test-suite/bugs/closed/1545.v deleted file mode 100644 index 9ef796faf7..0000000000 --- a/test-suite/bugs/closed/1545.v +++ /dev/null @@ -1,20 +0,0 @@ -Module Type TIT. - -Inductive X:Set:= - b:X. -End TIT. - - -Module Type TOTO. -Declare Module t:TIT. -Inductive titi:Set:= - a:t.X->titi. -End TOTO. - - -Module toto (ta:TOTO). -Module ti:=ta.t. - -Definition ex1:forall (c d:ti.X), (ta.a d)=(ta.a c) -> d=c. -intros. -injection H. diff --git a/test-suite/bugs/closed/1547.v b/test-suite/bugs/closed/1547.v deleted file mode 100644 index 166fa7a9f2..0000000000 --- a/test-suite/bugs/closed/1547.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Compatibility of Require with backtracking at interactive module end *) - -Module A. -Require List. -End A. diff --git a/test-suite/bugs/closed/1551.v b/test-suite/bugs/closed/1551.v deleted file mode 100644 index 48f0b55129..0000000000 --- a/test-suite/bugs/closed/1551.v +++ /dev/null @@ -1,13 +0,0 @@ -Module Type S. - Parameter empty: Set. -End S. - -Module D (M:S). - Import M. - Definition empty:=nat. -End D. - -Module D' (M:S). - Import M. - Definition empty:Set. exact nat. Qed. -End D'. diff --git a/test-suite/bugs/closed/1568.v b/test-suite/bugs/closed/1568.v deleted file mode 100644 index 3609e9c83b..0000000000 --- a/test-suite/bugs/closed/1568.v +++ /dev/null @@ -1,13 +0,0 @@ -CoInductive A: Set := - mk_A: B -> A -with B: Set := - mk_B: A -> B. - -CoFixpoint a:A := mk_A b -with b:B := mk_B a. - -Goal b = match a with mk_A a1 => a1 end. - simpl. reflexivity. -Qed. - - diff --git a/test-suite/bugs/closed/1576.v b/test-suite/bugs/closed/1576.v deleted file mode 100644 index 3621f7a1ff..0000000000 --- a/test-suite/bugs/closed/1576.v +++ /dev/null @@ -1,38 +0,0 @@ -Module Type TA. -Parameter t : Set. -End TA. - -Module Type TB. -Declare Module A: TA. -End TB. - -Module Type TC. -Declare Module B : TB. -End TC. - -Module Type TD. - -Declare Module B: TB . -Declare Module C: TC - with Module B := B . -End TD. - -Module Type TE. -Declare Module D : TD. -End TE. - -Module Type TF. -Declare Module E: TE. -End TF. - -Module G (D: TD). -Module B' := D.C.B. -End G. - -Module H (F: TF). -Module I := G(F.E.D). -End H. - -Declare Module F: TF. -Module K := H(F). - diff --git a/test-suite/bugs/closed/1582.v b/test-suite/bugs/closed/1582.v deleted file mode 100644 index be5d3dd211..0000000000 --- a/test-suite/bugs/closed/1582.v +++ /dev/null @@ -1,15 +0,0 @@ -Require Import Peano_dec. - -Definition fact_F : - forall (n:nat), - (forall m, m nat) -> - nat. -refine - (fun n fact_rec => - if eq_nat_dec n 0 then - 1 - else - let fn := fact_rec (n-1) _ in - n * fn). -Admitted. - diff --git a/test-suite/bugs/closed/1584.v b/test-suite/bugs/closed/1584.v deleted file mode 100644 index 926af7dd1c..0000000000 --- a/test-suite/bugs/closed/1584.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Export Reals. - -Parameter toto : nat -> nat -> nat. - -Notation " e # f " := (toto e f) (at level 30, f at level 0). diff --git a/test-suite/bugs/closed/1604.v b/test-suite/bugs/closed/1604.v deleted file mode 100644 index 22c3df824b..0000000000 --- a/test-suite/bugs/closed/1604.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Setoid. - -Parameter F : nat -> nat. -Axiom F_id : forall n : nat, n = F n. -Goal forall n : nat, F n = n. -intro n. setoid_rewrite F_id at 3. reflexivity. -Qed. diff --git a/test-suite/bugs/closed/1614.v b/test-suite/bugs/closed/1614.v deleted file mode 100644 index 6bc165d406..0000000000 --- a/test-suite/bugs/closed/1614.v +++ /dev/null @@ -1,21 +0,0 @@ -Require Import Ring. -Require Import ArithRing. - -Fixpoint eq_nat_bool (x y : nat) {struct x} : bool := -match x, y with -| 0, 0 => true -| S x', S y' => eq_nat_bool x' y' -| _, _ => false -end. - -Theorem eq_nat_bool_implies_eq : forall x y, eq_nat_bool x y = true -> x = y. -Proof. -induction x; destruct y; simpl; intro H; try (reflexivity || inversion H). -apply IHx in H; rewrite H; reflexivity. -Qed. - -Add Ring MyNatSRing : natSRth (decidable eq_nat_bool_implies_eq). - -Goal 0 = 0. - ring. -Qed. diff --git a/test-suite/bugs/closed/1618.v b/test-suite/bugs/closed/1618.v deleted file mode 100644 index a9b067ceb2..0000000000 --- a/test-suite/bugs/closed/1618.v +++ /dev/null @@ -1,23 +0,0 @@ -Inductive A: Set := -| A1: nat -> A. - -Definition A_size (a: A) : nat := - match a with - | A1 n => 0 - end. - -Require Import Recdef. - -Function n3 (P: A -> Prop) (f: forall n, P (A1 n)) (a: A) {struct a} : P a := - match a return (P a) with - | A1 n => f n - end. - - -Function n1 (P: A -> Prop) (f: forall n, P (A1 n)) (a: A) {measure A_size a} : -P -a := - match a return (P a) with - | A1 n => f n - end. - diff --git a/test-suite/bugs/closed/1634.v b/test-suite/bugs/closed/1634.v deleted file mode 100644 index 0150c25038..0000000000 --- a/test-suite/bugs/closed/1634.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Export Relation_Definitions. -Require Export Setoid. - -Variable A : Type. -Variable S : A -> Type. -Variable Seq : forall {a:A}, relation (S a). - -Hypothesis Seq_refl : forall {a:A} (x : S a), Seq x x. -Hypothesis Seq_sym : forall {a:A} (x y : S a), Seq x y -> Seq y x. -Hypothesis Seq_trans : forall {a:A} (x y z : S a), Seq x y -> Seq y z -> -Seq x z. - -Add Parametric Relation a : (S a) Seq - reflexivity proved by Seq_refl - symmetry proved by Seq_sym - transitivity proved by Seq_trans - as S_Setoid. - -Goal forall (a : A) (x y : S a), Seq x y -> Seq x y. - intros a x y H. - setoid_replace x with y. - reflexivity. - trivial. -Qed. diff --git a/test-suite/bugs/closed/1643.v b/test-suite/bugs/closed/1643.v deleted file mode 100644 index 879a65b183..0000000000 --- a/test-suite/bugs/closed/1643.v +++ /dev/null @@ -1,20 +0,0 @@ -(* Check some aspects of that the algorithm used to possibly reuse a - global name in the recursive calls (coinductive case) *) - -CoInductive Str : Set := Cons (h:nat) (t:Str). - -Definition decomp_func (s:Str) := - match s with - | Cons h t => Cons h t - end. - -Theorem decomp s: s = decomp_func s. -Proof. - case s; simpl; reflexivity. -Qed. - -Definition zeros := (cofix z : Str := Cons 0 z). -Lemma zeros_rw : zeros = Cons 0 zeros. - rewrite (decomp zeros). - simpl. -Admitted. diff --git a/test-suite/bugs/closed/1680.v b/test-suite/bugs/closed/1680.v deleted file mode 100644 index 524c7bab42..0000000000 --- a/test-suite/bugs/closed/1680.v +++ /dev/null @@ -1,9 +0,0 @@ -Ltac int1 := let h := fresh in intro h. - -Goal nat -> nat -> True. - let h' := fresh in (let h := fresh in intro h); intro h'. - Restart. let h' := fresh in int1; intro h'. - trivial. -Qed. - - diff --git a/test-suite/bugs/closed/1683.v b/test-suite/bugs/closed/1683.v deleted file mode 100644 index 3e99694b3c..0000000000 --- a/test-suite/bugs/closed/1683.v +++ /dev/null @@ -1,42 +0,0 @@ -Require Import Setoid. - -Section SetoidBug. - -Variable ms : Type. -Variable ms_type : ms -> Type. -Variable ms_eq : forall (A:ms), relation (ms_type A). - -Variable CR : ms. - -Record Ring : Type := -{Ring_type : Type}. - -Variable foo : forall (A:Ring), nat -> Ring_type A. -Variable IR : Ring. -Variable IRasCR : Ring_type IR -> ms_type CR. - -Definition CRasCRing : Ring := Build_Ring (ms_type CR). - -Hypothesis ms_refl : forall A x, ms_eq A x x. -Hypothesis ms_sym : forall A x y, ms_eq A x y -> ms_eq A y x. -Hypothesis ms_trans : forall A x y z, ms_eq A x y -> ms_eq A y z -> ms_eq A x z. - -Add Parametric Relation A : (ms_type A) (ms_eq A) - reflexivity proved by (ms_refl A) - symmetry proved by (ms_sym A) - transitivity proved by (ms_trans A) - as ms_Setoid. - -Hypothesis foobar : forall n, ms_eq CR (IRasCR (foo IR n)) (foo CRasCRing n). - -Goal forall (b:ms_type CR), - ms_eq CR (IRasCR (foo IR O)) b -> - ms_eq CR (IRasCR (foo IR O)) b. -intros b H. -rewrite foobar. -rewrite foobar in H. -assumption. -Qed. - - - diff --git a/test-suite/bugs/closed/1696.v b/test-suite/bugs/closed/1696.v deleted file mode 100644 index 0826428a34..0000000000 --- a/test-suite/bugs/closed/1696.v +++ /dev/null @@ -1,16 +0,0 @@ -Require Import Setoid. - -Inductive mynat := z : mynat | s : mynat -> mynat. - -Parameter E : mynat -> mynat -> Prop. -Axiom E_equiv : equiv mynat E. - -Add Relation mynat E - reflexivity proved by (proj1 E_equiv) - symmetry proved by (proj2 (proj2 E_equiv)) - transitivity proved by (proj1 (proj2 E_equiv)) -as E_rel. - -Notation "x == y" := (E x y) (at level 70). - -Goal z == s z -> s z == z. intros H. setoid_rewrite H at 2. reflexivity. Qed. diff --git a/test-suite/bugs/closed/1703.v b/test-suite/bugs/closed/1703.v deleted file mode 100644 index 114e3185b8..0000000000 --- a/test-suite/bugs/closed/1703.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Check correct binding of intros until used in Ltac *) - -Ltac intros_until n := intros until n. - -Goal forall i j m n : nat, i = 0 /\ j = 0 /\ m = 0 /\ n = 0. -intro i. -Fail intros until i. -Abort. diff --git a/test-suite/bugs/closed/1704.v b/test-suite/bugs/closed/1704.v deleted file mode 100644 index 7d8ba5b8da..0000000000 --- a/test-suite/bugs/closed/1704.v +++ /dev/null @@ -1,18 +0,0 @@ -Require Import TestSuite.admit. - -Require Import Setoid. -Parameter E : nat -> nat -> Prop. -Axiom E_equiv : equiv nat E. -Add Relation nat E -reflexivity proved by (proj1 E_equiv) -symmetry proved by (proj2 (proj2 E_equiv)) -transitivity proved by (proj1 (proj2 E_equiv)) -as E_rel. -Notation "x == y" := (E x y) (at level 70, no associativity). -Axiom r : False -> 0 == 1. -Goal 0 == 0. -Proof. -rewrite r. -reflexivity. -admit. -Qed. diff --git a/test-suite/bugs/closed/1711.v b/test-suite/bugs/closed/1711.v deleted file mode 100644 index e16612e380..0000000000 --- a/test-suite/bugs/closed/1711.v +++ /dev/null @@ -1,34 +0,0 @@ -(* Test for evar map consistency - was failing at some point and was *) -(* assumed to be solved from revision 10151 (but using a bad fix) *) - -Require Import List. -Set Implicit Arguments. - -Inductive rose : Set := Rose : nat -> list rose -> rose. - -Section RoseRec. -Variables (P: rose -> Set)(L: list rose -> Set). -Hypothesis - (R: forall n rs, L rs -> P (Rose n rs)) - (Lnil: L nil) - (Lcons: forall r rs, P r -> L rs -> L (cons r rs)). - -Fixpoint rose_rec2 (t:rose) {struct t} : P t := - match t as x return P x with - | Rose n rs => - R n ((fix rs_ind (l' : list rose): L l' := - match l' as x return L x with - | nil => Lnil - | cons t tl => Lcons (rose_rec2 t) (rs_ind tl) - end) - rs) - end. -End RoseRec. - -Lemma rose_map : rose -> rose. -Proof. intro H; elim H using rose_rec2 with - (L:=fun _ => list rose); (* was assumed to fail here *) -(* (L:=fun (_:list rose) => list rose); *) - clear H; simpl; intros. - exact (Rose n rs). exact nil. exact (H::H0). -Defined. diff --git a/test-suite/bugs/closed/1718.v b/test-suite/bugs/closed/1718.v deleted file mode 100644 index 715fa94199..0000000000 --- a/test-suite/bugs/closed/1718.v +++ /dev/null @@ -1,9 +0,0 @@ -(* lazy delta unfolding used to miss delta on rels and vars (fixed in 10172) *) - -Check - let g := fun _ => 0 in - fix f (n : nat) := - match n with - | 0 => g f - | S n' => 0 - end. diff --git a/test-suite/bugs/closed/1738.v b/test-suite/bugs/closed/1738.v deleted file mode 100644 index ef52c876c1..0000000000 --- a/test-suite/bugs/closed/1738.v +++ /dev/null @@ -1,30 +0,0 @@ -Require Import FSets. - -Module SomeSetoids (Import M:FSetInterface.S). - -Lemma Equal_refl : forall s, s[=]s. -Proof. red; split; auto. Qed. - -Add Relation t Equal - reflexivity proved by Equal_refl - symmetry proved by eq_sym - transitivity proved by eq_trans - as EqualSetoid. - -Add Morphism Empty with signature Equal ==> iff as Empty_m. -Proof. -unfold Equal, Empty; firstorder. -Qed. - -End SomeSetoids. - -Module Test (Import M:FSetInterface.S). - Module A:=SomeSetoids M. - Module B:=SomeSetoids M. (* lots of warning *) - - Lemma Test : forall s s', s[=]s' -> Empty s -> Empty s'. - intros. - rewrite H in H0. - assumption. -Qed. -End Test. diff --git a/test-suite/bugs/closed/1740.v b/test-suite/bugs/closed/1740.v deleted file mode 100644 index ec4a7a6bcb..0000000000 --- a/test-suite/bugs/closed/1740.v +++ /dev/null @@ -1,23 +0,0 @@ -(* Check that expansion of alias in pattern-matching compilation is no - longer dependent of whether the pattern-matching problem occurs in a - typed context or at toplevel (solved from revision 10883) *) - -Definition f := - fun n m : nat => - match n, m with - | O, _ => O - | n, O => n - | _, _ => O - end. - -Goal f = - fun n m : nat => - match n, m with - | O, _ => O - | n, O => n - | _, _ => O - end. - unfold f. - reflexivity. -Qed. - diff --git a/test-suite/bugs/closed/1754.v b/test-suite/bugs/closed/1754.v deleted file mode 100644 index 06b8dce851..0000000000 --- a/test-suite/bugs/closed/1754.v +++ /dev/null @@ -1,24 +0,0 @@ -Axiom hp : Set. -Axiom cont : nat -> hp -> Prop. -Axiom sconj : (hp -> Prop) -> (hp -> Prop) -> hp -> Prop. -Axiom sconjImpl : forall h A B, - (sconj A B) h -> forall (A' B': hp -> Prop), - (forall h', A h' -> A' h') -> - (forall h', B h' -> B' h') -> - (sconj A' B') h. - -Definition cont' (h:hp) := exists y, cont y h. - -Lemma foo : forall h x y A, - (sconj (cont x) (sconj (cont y) A)) h -> - (sconj cont' (sconj cont' A)) h. -Proof. - intros h x y A H. - eapply sconjImpl. - 2:intros h' Hp'; econstructor; apply Hp'. - 2:intros h' Hp'; eapply sconjImpl. - 3:intros h'' Hp''; econstructor; apply Hp''. - 3:intros h'' Hp''; apply Hp''. - 2:apply Hp'. - clear H. -Admitted. diff --git a/test-suite/bugs/closed/1773.v b/test-suite/bugs/closed/1773.v deleted file mode 100644 index 211af89b70..0000000000 --- a/test-suite/bugs/closed/1773.v +++ /dev/null @@ -1,9 +0,0 @@ -(* An occur-check test was done too early *) - -Goal forall B C : nat -> nat -> Prop, forall k, - (exists A, (forall k', C A k' -> B A k') -> B A k). -Proof. - intros B C k. - econstructor. - intros X. - apply X. (* used to fail here *) diff --git a/test-suite/bugs/closed/1774.v b/test-suite/bugs/closed/1774.v deleted file mode 100644 index 4c24b481bd..0000000000 --- a/test-suite/bugs/closed/1774.v +++ /dev/null @@ -1,18 +0,0 @@ -Axiom pl : (nat -> Prop) -> (nat -> Prop) -> (nat -> Prop). -Axiom plImp : forall k P Q, - pl P Q k -> forall (P':nat -> Prop), - (forall k', P k' -> P' k') -> forall (Q':nat -> Prop), - (forall k', Q k' -> Q' k') -> - pl P' Q' k. - -Definition nexists (P:nat -> nat -> Prop) : nat -> Prop := - fun k' => exists k, P k k'. - -Goal forall k (A:nat -> nat -> Prop) (B:nat -> Prop), - pl (nexists A) B k. -intros. -eapply plImp. -2:intros m' M'; econstructor; apply M'. -2:intros m' M'; apply M'. -simpl. -Admitted. diff --git a/test-suite/bugs/closed/1775.v b/test-suite/bugs/closed/1775.v deleted file mode 100644 index 932949a371..0000000000 --- a/test-suite/bugs/closed/1775.v +++ /dev/null @@ -1,39 +0,0 @@ -Axiom pair : nat -> nat -> nat -> Prop. -Axiom pl : (nat -> Prop) -> (nat -> Prop) -> (nat -> Prop). -Axiom plImp : forall k P Q, - pl P Q k -> forall (P':nat -> Prop), - (forall k', P k' -> P' k') -> forall (Q':nat -> Prop), - (forall k', Q k' -> Q' k') -> - pl P' Q' k. - -Definition nexists (P:nat -> nat -> Prop) : nat -> Prop := - fun k' => exists k, P k k'. - -Goal forall s k k' m, - (pl k' (nexists (fun w => (nexists (fun b => pl (pair w w) - (pl (pair s b) - (nexists (fun w0 => (nexists (fun a => pl (pair b w0) - (nexists (fun w1 => (nexists (fun c => pl - (pair a w1) (pl (pair a c) k))))))))))))))) m. -intros. -eapply plImp; [ | eauto | intros ]. -2:econstructor. -2:econstructor. -2:eapply plImp; [ | eauto | intros ]. -3:eapply plImp; [ | eauto | intros ]. -4:econstructor. -4:econstructor. -4:eapply plImp; [ | eauto | intros ]. -5:econstructor. -5:econstructor. -5:eauto. -4:eauto. -3:eauto. -2:eauto. - -assert (X := 1). -clear X. (* very slow! *) - -simpl. (* exception Not_found *) - -Admitted. diff --git a/test-suite/bugs/closed/1776.v b/test-suite/bugs/closed/1776.v deleted file mode 100644 index 58491f9de1..0000000000 --- a/test-suite/bugs/closed/1776.v +++ /dev/null @@ -1,22 +0,0 @@ -Axiom pair : nat -> nat -> nat -> Prop. -Axiom pl : (nat -> Prop) -> (nat -> Prop) -> (nat -> Prop). -Axiom plImpR : forall k P Q, - pl P Q k -> forall (Q':nat -> Prop), - (forall k', Q k' -> Q' k') -> - pl P Q' k. - -Definition nexists (P:nat -> nat -> Prop) : nat -> Prop := - fun k' => exists k, P k k'. - -Goal forall a A m, - True -> - (pl A (nexists (fun x => (nexists - (fun y => pl (pair a (S x)) (pair a (S y))))))) m. -Proof. - intros. - eapply plImpR; [ | intros; econstructor; econstructor; eauto]. - clear H; - match goal with - | |- (pl _ (pl (pair _ ?x) _)) _ => replace x with 0 - end. -Admitted. diff --git a/test-suite/bugs/closed/1779.v b/test-suite/bugs/closed/1779.v deleted file mode 100644 index 95bb66b962..0000000000 --- a/test-suite/bugs/closed/1779.v +++ /dev/null @@ -1,25 +0,0 @@ -Require Import Div2. - -Lemma double_div2: forall n, div2 (double n) = n. -exact (fun n => let _subcase := - let _cofact := fun _ : 0 = 0 => refl_equal 0 in - _cofact (let _fact := refl_equal 0 in _fact) in - let _subcase0 := - fun (m : nat) (Hrec : div2 (double m) = m) => - let _fact := f_equal div2 (double_S m) in - let _eq := trans_eq _fact (refl_equal (S (div2 (double m)))) in - let _eq0 := - trans_eq _eq - (trans_eq - (f_equal (fun f : nat -> nat => f (div2 (double m))) - (refl_equal S)) (f_equal S Hrec)) in - _eq0 in - (fix _fix (__ : nat) : div2 (double __) = __ := - match __ as n return (div2 (double n) = n) with - | 0 => _subcase - | S __0 => - (fun _hrec : div2 (double __0) = __0 => _subcase0 __0 _hrec) - (_fix __0) - end) n). -Guarded. -Defined. diff --git a/test-suite/bugs/closed/1780.v b/test-suite/bugs/closed/1780.v deleted file mode 100644 index ade4462a79..0000000000 --- a/test-suite/bugs/closed/1780.v +++ /dev/null @@ -1,12 +0,0 @@ - -Definition bug := Eval vm_compute in eq_rect. -(* bug: -Error: Illegal application (Type Error): -The term "eq" of type "forall A : Type, A -> A -> Prop" -cannot be applied to the terms - "x" : "A" - "P" : "A -> Type" - "x0" : "A" -The 1st term has type "A" which should be coercible to -"Type". -*) diff --git a/test-suite/bugs/closed/1784.v b/test-suite/bugs/closed/1784.v deleted file mode 100644 index 25d1b192eb..0000000000 --- a/test-suite/bugs/closed/1784.v +++ /dev/null @@ -1,100 +0,0 @@ -Require Import List. -Require Import ZArith. -Require String. Open Scope string_scope. -Ltac Case s := let c := fresh "case" in set (c := s). - -Set Implicit Arguments. -Unset Strict Implicit. - -Inductive sv : Set := -| I : Z -> sv -| S : list sv -> sv. - -Section sv_induction. - -Variables - (VP: sv -> Prop) - (LP: list sv -> Prop) - - (VPint: forall n, VP (I n)) - (VPset: forall vs, LP vs -> VP (S vs)) - (lpcons: forall v vs, VP v -> LP vs -> LP (v::vs)) - (lpnil: LP nil). - -Fixpoint setl_value_indp (x:sv) {struct x}: VP x := - match x as x return VP x with - | I n => VPint n - | S vs => - VPset - ((fix values_indp (vs:list sv) {struct vs}: (LP vs) := - match vs as vs return LP vs with - | nil => lpnil - | v::vs => lpcons (setl_value_indp v) (values_indp vs) - end) vs) - end. -End sv_induction. - -Inductive slt : sv -> sv -> Prop := -| IC : forall z, slt (I z) (I z) -| IS : forall vs vs', slist_in vs vs' -> slt (S vs) (S vs') - -with sin : sv -> list sv -> Prop := -| Ihd : forall s s' sv', slt s s' -> sin s (s'::sv') -| Itl : forall s s' sv', sin s sv' -> sin s (s'::sv') - -with slist_in : list sv -> list sv -> Prop := -| Inil : forall sv', - slist_in nil sv' -| Icons : forall s sv sv', - sin s sv' -> - slist_in sv sv' -> - slist_in (s::sv) sv'. - -Hint Constructors sin slt slist_in. - -Require Import Program. - -Program Fixpoint lt_dec (x y:sv) { struct x } : {slt x y}+{~slt x y} := - match x with - | I x => - match y with - | I y => if (Z.eq_dec x y) then in_left else in_right - | S ys => in_right - end - | S xs => - match y with - | I y => in_right - | S ys => - let fix list_in (xs ys:list sv) {struct xs} : - {slist_in xs ys} + {~slist_in xs ys} := - match xs with - | nil => in_left - | x::xs => - let fix elem_in (ys:list sv) : {sin x ys}+{~sin x ys} := - match ys with - | nil => in_right - | y::ys => if lt_dec x y then in_left else if elem_in - ys then in_left else in_right - end - in - if elem_in ys then - if list_in xs ys then in_left else in_right - else in_right - end - in if list_in xs ys then in_left else in_right - end - end. - -Next Obligation. intro H0. apply H; inversion H0; subst; trivial. Defined. -Next Obligation. intro H; inversion H. Defined. -Next Obligation. intro H; inversion H. Defined. -Next Obligation. intro H; inversion H; subst. Defined. -Next Obligation. - intro H1; contradict H. inversion H1; subst. assumption. - contradict H0; assumption. Defined. -Next Obligation. intro H1; contradict H0. inversion H1; subst. assumption. Defined. -Next Obligation. - intro H1; contradict H. inversion H1; subst. assumption. Defined. -Next Obligation. - intro H0; contradict H. inversion H0; subst; auto. Defined. - diff --git a/test-suite/bugs/closed/1787.v b/test-suite/bugs/closed/1787.v deleted file mode 100644 index 8e1024e6ec..0000000000 --- a/test-suite/bugs/closed/1787.v +++ /dev/null @@ -1,11 +0,0 @@ -Parameter P : nat -> nat -> Prop. -Parameter Q : nat -> nat -> Prop. -Axiom A : forall x x' x'', P x x' -> Q x'' x' -> P x x''. - -Goal (P 1 3) -> (Q 1 3) -> (P 1 1). -intros H H'. -refine ((fun H1 : P 1 _ => let H2 := (_:Q 1 _) in A _ _ _ H1 H2) _). -clear. -Admitted. - - diff --git a/test-suite/bugs/closed/1791.v b/test-suite/bugs/closed/1791.v deleted file mode 100644 index be0e8ae8ba..0000000000 --- a/test-suite/bugs/closed/1791.v +++ /dev/null @@ -1,38 +0,0 @@ -(* simpl performs eta expansion *) - -Set Implicit Arguments. -Require Import List. - -Definition k0 := Set. -Definition k1 := k0 -> k0. - -(** iterating X n times *) -Fixpoint Pow (X:k1)(k:nat){struct k}:k1:= - match k with 0 => fun X => X - | S k' => fun A => X (Pow X k' A) - end. - -Parameter Bush: k1. -Parameter BushToList: forall (A:k0), Bush A -> list A. - -Definition BushnToList (n:nat)(A:k0)(t:Pow Bush n A): list A. -Proof. - intros. - induction n. - exact (t::nil). - simpl in t. - exact (flat_map IHn (BushToList t)). -Defined. - -Parameter bnil : forall (A:k0), Bush A. -Axiom BushToList_bnil: forall (A:k0), BushToList (bnil A) = nil(A:=A). - -Lemma BushnToList_bnil (n:nat)(A:k0): - BushnToList (S n) A (bnil (Pow Bush n A)) = nil. -Proof. - intros. - simpl. - rewrite BushToList_bnil. - simpl. - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/1834.v b/test-suite/bugs/closed/1834.v deleted file mode 100644 index 884ac01cd2..0000000000 --- a/test-suite/bugs/closed/1834.v +++ /dev/null @@ -1,174 +0,0 @@ -(* This tests rather deep nesting of abstracted terms *) - -(* This used to fail before Nov 2011 because of a de Bruijn indice bug - in extract_predicate. - - Note: use of eq_ok allows shorten notations but was not in the - original example -*) - -Scheme eq_rec_dep := Induction for eq Sort Type. - -Section Teq. - -Variable P0: Type. -Variable P1: forall (y0:P0), Type. -Variable P2: forall y0 (y1:P1 y0), Type. -Variable P3: forall y0 y1 (y2:P2 y0 y1), Type. -Variable P4: forall y0 y1 y2 (y3:P3 y0 y1 y2), Type. -Variable P5: forall y0 y1 y2 y3 (y4:P4 y0 y1 y2 y3), Type. - -Variable x0:P0. - -Inductive eq0 : P0 -> Prop := - refl0: eq0 x0. - -Definition eq_0 y0 := x0 = y0. - -Variable x1:P1 x0. - -Inductive eq1 : forall y0, P1 y0 -> Prop := - refl1: eq1 x0 x1. - -Definition S0_0 y0 (e0:eq_0 y0) := - eq_rec_dep P0 x0 (fun y0 e0 => P1 y0) x1 y0 e0. - -Definition eq_ok0 y0 y1 (E: eq_0 y0) := S0_0 y0 E = y1. - -Definition eq_1 y0 y1 := - {E0:eq_0 y0 | eq_ok0 y0 y1 E0}. - -Variable x2:P2 x0 x1. - -Inductive eq2 : -forall y0 y1, P2 y0 y1 -> Prop := -refl2: eq2 x0 x1 x2. - -Definition S1_0 y0 (e0:eq_0 y0) := -eq_rec_dep P0 x0 (fun y0 e0 => P2 y0 (S0_0 y0 e0)) x2 y0 e0. - -Definition S1_1 y0 y1 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) := - eq_rec_dep (P1 y0) (S0_0 y0 e0) (fun y1 e1 => P2 y0 y1) - (S1_0 y0 e0) - y1 e1. - -Definition eq_ok1 y0 y1 y2 (E: eq_1 y0 y1) := - match E with exist _ e0 e1 => S1_1 y0 y1 e0 e1 = y2 end. - -Definition eq_2 y0 y1 y2 := - {E1:eq_1 y0 y1 | eq_ok1 y0 y1 y2 E1}. - -Variable x3:P3 x0 x1 x2. - -Inductive eq3 : -forall y0 y1 y2, P3 y0 y1 y2 -> Prop := -refl3: eq3 x0 x1 x2 x3. - -Definition S2_0 y0 (e0:eq_0 y0) := -eq_rec_dep P0 x0 (fun y0 e0 => P3 y0 (S0_0 y0 e0) (S1_0 y0 e0)) x3 y0 e0. - -Definition S2_1 y0 y1 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) := - eq_rec_dep (P1 y0) (S0_0 y0 e0) - (fun y1 e1 => P3 y0 y1 (S1_1 y0 y1 e0 e1)) - (S2_0 y0 e0) - y1 e1. - -Definition S2_2 y0 y1 y2 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) - (e2:S1_1 y0 y1 e0 e1 = y2) := - eq_rec_dep (P2 y0 y1) (S1_1 y0 y1 e0 e1) - (fun y2 e2 => P3 y0 y1 y2) - (S2_1 y0 y1 e0 e1) - y2 e2. - -Definition eq_ok2 y0 y1 y2 y3 (E: eq_2 y0 y1 y2) : Prop := - match E with exist _ (exist _ e0 e1) e2 => - S2_2 y0 y1 y2 e0 e1 e2 = y3 end. - -Definition eq_3 y0 y1 y2 y3 := - {E2: eq_2 y0 y1 y2 | eq_ok2 y0 y1 y2 y3 E2}. - -Variable x4:P4 x0 x1 x2 x3. - -Inductive eq4 : -forall y0 y1 y2 y3, P4 y0 y1 y2 y3 -> Prop := -refl4: eq4 x0 x1 x2 x3 x4. - -Definition S3_0 y0 (e0:eq_0 y0) := -eq_rec_dep P0 x0 (fun y0 e0 => P4 y0 (S0_0 y0 e0) (S1_0 y0 e0) (S2_0 y0 e0)) - x4 y0 e0. - -Definition S3_1 y0 y1 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) := - eq_rec_dep (P1 y0) (S0_0 y0 e0) - (fun y1 e1 => P4 y0 y1 (S1_1 y0 y1 e0 e1) (S2_1 y0 y1 e0 e1)) - (S3_0 y0 e0) - y1 e1. - -Definition S3_2 y0 y1 y2 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) - (e2:S1_1 y0 y1 e0 e1 = y2) := - eq_rec_dep (P2 y0 y1) (S1_1 y0 y1 e0 e1) - (fun y2 e2 => P4 y0 y1 y2 (S2_2 y0 y1 y2 e0 e1 e2)) - (S3_1 y0 y1 e0 e1) - y2 e2. - -Definition S3_3 y0 y1 y2 y3 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) - (e2:S1_1 y0 y1 e0 e1 = y2) (e3:S2_2 y0 y1 y2 e0 e1 e2 = y3):= - eq_rec_dep (P3 y0 y1 y2) (S2_2 y0 y1 y2 e0 e1 e2) - (fun y3 e3 => P4 y0 y1 y2 y3) - (S3_2 y0 y1 y2 e0 e1 e2) - y3 e3. - -Definition eq_ok3 y0 y1 y2 y3 y4 (E: eq_3 y0 y1 y2 y3) : Prop := - match E with exist _ (exist _ (exist _ e0 e1) e2) e3 => - S3_3 y0 y1 y2 y3 e0 e1 e2 e3 = y4 end. - -Definition eq_4 y0 y1 y2 y3 y4 := - {E3: eq_3 y0 y1 y2 y3 | eq_ok3 y0 y1 y2 y3 y4 E3}. - -Variable x5:P5 x0 x1 x2 x3 x4. - -Inductive eq5 : -forall y0 y1 y2 y3 y4, P5 y0 y1 y2 y3 y4 -> Prop := -refl5: eq5 x0 x1 x2 x3 x4 x5. - -Definition S4_0 y0 (e0:eq_0 y0) := -eq_rec_dep P0 x0 -(fun y0 e0 => P5 y0 (S0_0 y0 e0) (S1_0 y0 e0) (S2_0 y0 e0) (S3_0 y0 e0)) - x5 y0 e0. - -Definition S4_1 y0 y1 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) := - eq_rec_dep (P1 y0) (S0_0 y0 e0) - (fun y1 e1 => P5 y0 y1 (S1_1 y0 y1 e0 e1) (S2_1 y0 y1 e0 e1) (S3_1 y0 y1 e0 -e1)) - (S4_0 y0 e0) - y1 e1. - -Definition S4_2 y0 y1 y2 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) - (e2:S1_1 y0 y1 e0 e1 = y2) := - eq_rec_dep (P2 y0 y1) (S1_1 y0 y1 e0 e1) - (fun y2 e2 => P5 y0 y1 y2 (S2_2 y0 y1 y2 e0 e1 e2) (S3_2 y0 y1 y2 e0 e1 e2)) - (S4_1 y0 y1 e0 e1) - y2 e2. - -Definition S4_3 y0 y1 y2 y3 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) - (e2:S1_1 y0 y1 e0 e1 = y2) (e3:S2_2 y0 y1 y2 e0 e1 e2 = y3):= - eq_rec_dep (P3 y0 y1 y2) (S2_2 y0 y1 y2 e0 e1 e2) - (fun y3 e3 => P5 y0 y1 y2 y3 (S3_3 y0 y1 y2 y3 e0 e1 e2 e3)) - (S4_2 y0 y1 y2 e0 e1 e2) - y3 e3. - -Definition S4_4 y0 y1 y2 y3 y4 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) - (e2:S1_1 y0 y1 e0 e1 = y2) (e3:S2_2 y0 y1 y2 e0 e1 e2 = y3) - (e4:S3_3 y0 y1 y2 y3 e0 e1 e2 e3 = y4) := - eq_rec_dep (P4 y0 y1 y2 y3) (S3_3 y0 y1 y2 y3 e0 e1 e2 e3) - (fun y4 e4 => P5 y0 y1 y2 y3 y4) - (S4_3 y0 y1 y2 y3 e0 e1 e2 e3) - y4 e4. - -Definition eq_ok4 y0 y1 y2 y3 y4 y5 (E: eq_4 y0 y1 y2 y3 y4) : Prop := - match E with exist _ (exist _ (exist _ (exist _ e0 e1) e2) e3) e4 => - S4_4 y0 y1 y2 y3 y4 e0 e1 e2 e3 e4 = y5 end. - -Definition eq_5 y0 y1 y2 y3 y4 y5 := - {E4: eq_4 y0 y1 y2 y3 y4 | eq_ok4 y0 y1 y2 y3 y4 y5 E4 }. - -End Teq. diff --git a/test-suite/bugs/closed/1844.v b/test-suite/bugs/closed/1844.v deleted file mode 100644 index c41e45900a..0000000000 --- a/test-suite/bugs/closed/1844.v +++ /dev/null @@ -1,217 +0,0 @@ -Require Import ZArith. - -Definition zeq := Z.eq_dec. - -Definition update (A: Set) (x: Z) (v: A) (s: Z -> A) : Z -> A := - fun y => if zeq x y then v else s y. - -Arguments update [A]. - -Definition ident := Z. -Parameter operator: Set. -Parameter value: Set. -Parameter is_true: value -> Prop. -Definition label := Z. - -Inductive expr : Set := - | Evar: ident -> expr - | Econst: value -> expr - | Eop: operator -> expr -> expr -> expr. - -Inductive stmt : Set := - | Sskip: stmt - | Sassign: ident -> expr -> stmt - | Scall: ident -> ident -> expr -> stmt (* x := f(e) *) - | Sreturn: expr -> stmt - | Sseq: stmt -> stmt -> stmt - | Sifthenelse: expr -> stmt -> stmt -> stmt - | Sloop: stmt -> stmt - | Sblock: stmt -> stmt - | Sexit: nat -> stmt - | Slabel: label -> stmt -> stmt - | Sgoto: label -> stmt. - -Record function : Set := mkfunction { - fn_param: ident; - fn_body: stmt -}. - -Parameter program: ident -> option function. - -Parameter main_function: ident. - -Definition store := ident -> value. - -Parameter empty_store : store. - -Parameter eval_op: operator -> value -> value -> option value. - -Fixpoint eval_expr (st: store) (e: expr) {struct e} : option value := - match e with - | Evar v => Some (st v) - | Econst v => Some v - | Eop op e1 e2 => - match eval_expr st e1, eval_expr st e2 with - | Some v1, Some v2 => eval_op op v1 v2 - | _, _ => None - end - end. - -Inductive outcome: Set := - | Onormal: outcome - | Oexit: nat -> outcome - | Ogoto: label -> outcome - | Oreturn: value -> outcome. - -Definition outcome_block (out: outcome) : outcome := - match out with - | Onormal => Onormal - | Oexit O => Onormal - | Oexit (S m) => Oexit m - | Ogoto lbl => Ogoto lbl - | Oreturn v => Oreturn v - end. - -Fixpoint label_defined (lbl: label) (s: stmt) {struct s}: Prop := - match s with - | Sskip => False - | Sassign id e => False - | Scall id fn e => False - | Sreturn e => False - | Sseq s1 s2 => label_defined lbl s1 \/ label_defined lbl s2 - | Sifthenelse e s1 s2 => label_defined lbl s1 \/ label_defined lbl s2 - | Sloop s1 => label_defined lbl s1 - | Sblock s1 => label_defined lbl s1 - | Sexit n => False - | Slabel lbl1 s1 => lbl1 = lbl \/ label_defined lbl s1 - | Sgoto lbl => False - end. - -Inductive exec : stmt -> store -> outcome -> store -> Prop := - | exec_skip: forall st, - exec Sskip st Onormal st - | exec_assign: forall id e st v, - eval_expr st e = Some v -> - exec (Sassign id e) st Onormal (update id v st) - | exec_call: forall id fn e st v1 f v2 st', - eval_expr st e = Some v1 -> - program fn = Some f -> - exec_function f (update f.(fn_param) v1 empty_store) v2 st' -> - exec (Scall id fn e) st Onormal (update id v2 st) - | exec_return: forall e st v, - eval_expr st e = Some v -> - exec (Sreturn e) st (Oreturn v) st - | exec_seq_2: forall s1 s2 st st1 out' st', - exec s1 st Onormal st1 -> exec s2 st1 out' st' -> - exec (Sseq s1 s2) st out' st' - | exec_seq_1: forall s1 s2 st out st', - exec s1 st out st' -> out <> Onormal -> - exec (Sseq s1 s2) st out st' - | exec_ifthenelse_true: forall e s1 s2 st out st' v, - eval_expr st e = Some v -> is_true v -> exec s1 st out st' -> - exec (Sifthenelse e s1 s2) st out st' - | exec_ifthenelse_false: forall e s1 s2 st out st' v, - eval_expr st e = Some v -> ~is_true v -> exec s2 st out st' -> - exec (Sifthenelse e s1 s2) st out st' - | exec_loop_loop: forall s st st1 out' st', - exec s st Onormal st1 -> - exec (Sloop s) st1 out' st' -> - exec (Sloop s) st out' st' - | exec_loop_stop: forall s st st' out, - exec s st out st' -> out <> Onormal -> - exec (Sloop s) st out st' - | exec_block: forall s st out st', - exec s st out st' -> - exec (Sblock s) st (outcome_block out) st' - | exec_exit: forall n st, - exec (Sexit n) st (Oexit n) st - | exec_label: forall s lbl st st' out, - exec s st out st' -> - exec (Slabel lbl s) st out st' - | exec_goto: forall st lbl, - exec (Sgoto lbl) st (Ogoto lbl) st - -(** [execg lbl stmt st out st'] starts executing at label [lbl] within [s], - in initial store [st]. The result of the execution is the outcome - [out] with final store [st']. *) - -with execg: label -> stmt -> store -> outcome -> store -> Prop := - | execg_left_seq_2: forall lbl s1 s2 st st1 out' st', - execg lbl s1 st Onormal st1 -> exec s2 st1 out' st' -> - execg lbl (Sseq s1 s2) st out' st' - | execg_left_seq_1: forall lbl s1 s2 st out st', - execg lbl s1 st out st' -> out <> Onormal -> - execg lbl (Sseq s1 s2) st out st' - | execg_right_seq: forall lbl s1 s2 st out st', - ~(label_defined lbl s1) -> - execg lbl s2 st out st' -> - execg lbl (Sseq s1 s2) st out st' - | execg_ifthenelse_left: forall lbl e s1 s2 st out st', - execg lbl s1 st out st' -> - execg lbl (Sifthenelse e s1 s2) st out st' - | execg_ifthenelse_right: forall lbl e s1 s2 st out st', - ~(label_defined lbl s1) -> - execg lbl s2 st out st' -> - execg lbl (Sifthenelse e s1 s2) st out st' - | execg_loop_loop: forall lbl s st st1 out' st', - execg lbl s st Onormal st1 -> - exec (Sloop s) st1 out' st' -> - execg lbl (Sloop s) st out' st' - | execg_loop_stop: forall lbl s st st' out, - execg lbl s st out st' -> out <> Onormal -> - execg lbl (Sloop s) st out st' - | execg_block: forall lbl s st out st', - execg lbl s st out st' -> - execg lbl (Sblock s) st (outcome_block out) st' - | execg_label_found: forall lbl s st st' out, - exec s st out st' -> - execg lbl (Slabel lbl s) st out st' - | execg_label_notfound: forall lbl s lbl' st st' out, - lbl' <> lbl -> - execg lbl s st out st' -> - execg lbl (Slabel lbl' s) st out st' - -(** [exec_finish out st st'] takes the outcome [out] and the store [st] - at the end of the evaluation of the program. If [out] is a [goto], - execute again the program starting at the corresponding label. - Iterate this way until [out] is [Onormal]. *) - -with exec_finish: function -> outcome -> store -> value -> store -> Prop := - | exec_finish_normal: forall f st v, - exec_finish f (Oreturn v) st v st - | exec_finish_goto: forall f lbl st out v st1 st', - execg lbl f.(fn_body) st out st1 -> - exec_finish f out st1 v st' -> - exec_finish f (Ogoto lbl) st v st' - -(** Execution of a function *) - -with exec_function: function -> store -> value -> store -> Prop := - | exec_function_intro: forall f st out st1 v st', - exec f.(fn_body) st out st1 -> - exec_finish f out st1 v st' -> - exec_function f st v st'. - -Scheme exec_ind4:= Minimality for exec Sort Prop - with execg_ind4:= Minimality for execg Sort Prop - with exec_finish_ind4 := Minimality for exec_finish Sort Prop - with exec_function_ind4 := Minimality for exec_function Sort Prop. - -Scheme exec_dind4:= Induction for exec Sort Prop - with execg_dind4:= Minimality for execg Sort Prop - with exec_finish_dind4 := Induction for exec_finish Sort Prop - with exec_function_dind4 := Induction for exec_function Sort Prop. - -Combined Scheme exec_inductiond from exec_dind4, execg_dind4, exec_finish_dind4, - exec_function_dind4. - -Scheme exec_dind4' := Induction for exec Sort Prop - with execg_dind4' := Induction for execg Sort Prop - with exec_finish_dind4' := Induction for exec_finish Sort Prop - with exec_function_dind4' := Induction for exec_function Sort Prop. - -Combined Scheme exec_induction from exec_ind4, execg_ind4, exec_finish_ind4, - exec_function_ind4. - -Combined Scheme exec_inductiond' from exec_dind4', execg_dind4', exec_finish_dind4', - exec_function_dind4'. diff --git a/test-suite/bugs/closed/1850.v b/test-suite/bugs/closed/1850.v deleted file mode 100644 index 26b48093b7..0000000000 --- a/test-suite/bugs/closed/1850.v +++ /dev/null @@ -1,4 +0,0 @@ -Parameter P : Type -> Type -> Type. -Notation "e |= t --> v" := (P e t v) (at level 100, t at level 54). -Fail Check (nat |= nat --> nat). - diff --git a/test-suite/bugs/closed/1859.v b/test-suite/bugs/closed/1859.v deleted file mode 100644 index 43acfe4ba2..0000000000 --- a/test-suite/bugs/closed/1859.v +++ /dev/null @@ -1,20 +0,0 @@ -Require Import Ring. -Require Import ArithRing. - -Ltac ring_simplify_neq := - match goal with - | [ H: ?X <> ?Y |- _ ] => progress ring_simplify X Y in H - end. - -Lemma toto : forall x y, x*1 <> y*1 -> y*1 <> x*1 -> x<>y. -Proof. - intros. - ring_simplify_neq. - ring_simplify_neq. - (* make sure ring_simplify has simplified both hypotheses *) - match goal with - | [ H: context[_*1] |- _ ] => fail 1 - | _ => idtac - end. - auto. -Qed. diff --git a/test-suite/bugs/closed/1865.v b/test-suite/bugs/closed/1865.v deleted file mode 100644 index 17c1998948..0000000000 --- a/test-suite/bugs/closed/1865.v +++ /dev/null @@ -1,18 +0,0 @@ -(* Check that tactics (here dependent inversion) do not generate - conversion problems T <= U with sup's of universes in U *) - -(* Submitted by David Nowak *) - -Inductive list (A:Set) : nat -> Set := -| nil : list A O -| cons : forall n, A -> list A n -> list A (S n). - -Definition f (n:nat) : Type := - match n with - | O => bool - | _ => unit - end. - -Goal forall A n, list A n -> f n. -intros A n. -dependent inversion n. diff --git a/test-suite/bugs/closed/1891.v b/test-suite/bugs/closed/1891.v deleted file mode 100644 index 5024a5bc97..0000000000 --- a/test-suite/bugs/closed/1891.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Check evar-evar unification *) - Inductive T (A: Set): Set := mkT: unit -> T A. - - Definition f (A: Set) (l: T A): unit := tt. - - Arguments f [A]. - - Lemma L (x: T unit): (unit -> T unit) -> unit. - Proof. - refine (match x return _ with mkT _ n => fun g => f (g _) end). - trivial. - Qed. - diff --git a/test-suite/bugs/closed/1898.v b/test-suite/bugs/closed/1898.v deleted file mode 100644 index 70461286ce..0000000000 --- a/test-suite/bugs/closed/1898.v +++ /dev/null @@ -1,6 +0,0 @@ -(* folding should not allow circular dependencies *) - -Lemma bug_fold_unfold : True. - set (h := 1). - Fail fold h in h. - Abort. diff --git a/test-suite/bugs/closed/1900.v b/test-suite/bugs/closed/1900.v deleted file mode 100644 index 6eea5db083..0000000000 --- a/test-suite/bugs/closed/1900.v +++ /dev/null @@ -1,8 +0,0 @@ -Parameter A : Type . - -Definition eq_A := @eq A. - -Goal forall x, eq_A x x. -intros. -reflexivity. -Qed. diff --git a/test-suite/bugs/closed/1901.v b/test-suite/bugs/closed/1901.v deleted file mode 100644 index 98e017f9d6..0000000000 --- a/test-suite/bugs/closed/1901.v +++ /dev/null @@ -1,11 +0,0 @@ -Require Import Relations. - -Record Poset{A:Type}(Le : relation A) : Type := - Build_Poset - { - Le_refl : forall x : A, Le x x; - Le_trans : forall x y z : A, Le x y -> Le y z -> Le x z; - Le_antisym : forall x y : A, Le x y -> Le y x -> x = y }. - -Definition nat_Poset : Poset Peano.le. -Admitted. diff --git a/test-suite/bugs/closed/1905.v b/test-suite/bugs/closed/1905.v deleted file mode 100644 index 3b8a3d2f68..0000000000 --- a/test-suite/bugs/closed/1905.v +++ /dev/null @@ -1,13 +0,0 @@ - -Require Import Setoid Program. - -Axiom t : Set. -Axiom In : nat -> t -> Prop. -Axiom InE : forall (x : nat) (s:t), impl (In x s) True. - -Goal forall a s, - In a s -> False. -Proof. - intros a s Ia. - rewrite InE in Ia. -Admitted. diff --git a/test-suite/bugs/closed/1907.v b/test-suite/bugs/closed/1907.v deleted file mode 100644 index 55fc823190..0000000000 --- a/test-suite/bugs/closed/1907.v +++ /dev/null @@ -1,7 +0,0 @@ -(* An example of type inference *) - -Axiom A : Type. -Definition f (x y : A) := x. -Axiom g : forall x y : A, f x y = y -> Prop. -Axiom x : A. -Check (g x _ (refl_equal x)). diff --git a/test-suite/bugs/closed/1912.v b/test-suite/bugs/closed/1912.v deleted file mode 100644 index 987a541778..0000000000 --- a/test-suite/bugs/closed/1912.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import ZArith. - -Goal forall x, Z.succ (Z.pred x) = x. -intros x. -omega. -Qed. diff --git a/test-suite/bugs/closed/1915.v b/test-suite/bugs/closed/1915.v deleted file mode 100644 index 2b0aed8c7d..0000000000 --- a/test-suite/bugs/closed/1915.v +++ /dev/null @@ -1,6 +0,0 @@ - -Require Import Setoid. - -Fail Goal forall x, impl True (x = 0) -> x = 0 -> False. -(*intros x H E. -rewrite H in E.*) diff --git a/test-suite/bugs/closed/1918.v b/test-suite/bugs/closed/1918.v deleted file mode 100644 index 9d92fe12b8..0000000000 --- a/test-suite/bugs/closed/1918.v +++ /dev/null @@ -1,376 +0,0 @@ -(** Occur-check for Meta (up to delta) *) - -(** LNMItPredShort.v Version 2.0 July 2008 *) -(** does not need impredicative Set, runs under V8.2, tested with SVN 11296 *) - -(** Copyright Ralph Matthes, I.R.I.T., C.N.R.S. & University of Toulouse*) - - -Set Implicit Arguments. - -(** the universe of all monotypes *) -Definition k0 := Set. - -(** the type of all type transformations *) -Definition k1 := k0 -> k0. - -(** the type of all rank-2 type transformations *) -Definition k2 := k1 -> k1. - -(** polymorphic identity *) -Definition id : forall (A:Set), A -> A := fun A x => x. - -(** composition *) -Definition comp (A B C:Set)(g:B->C)(f:A->B) : A->C := fun x => g (f x). - -Infix "o" := comp (at level 90). - -Definition sub_k1 (X Y:k1) : Type := - forall A:Set, X A -> Y A. - -Infix "c_k1" := sub_k1 (at level 60). - -(** monotonicity *) -Definition mon (X:k1) : Type := forall (A B:Set), (A -> B) -> X A -> X B. - -(** extensionality *) -Definition ext (X:k1)(h: mon X): Prop := - forall (A B:Set)(f g:A -> B), - (forall a, f a = g a) -> forall r, h _ _ f r = h _ _ g r. - -(** first functor law *) -Definition fct1 (X:k1)(m: mon X) : Prop := - forall (A:Set)(x:X A), m _ _ (id(A:=A)) x = x. - -(** second functor law *) -Definition fct2 (X:k1)(m: mon X) : Prop := - forall (A B C:Set)(f:A -> B)(g:B -> C)(x:X A), - m _ _ (g o f) x = m _ _ g (m _ _ f x). - -(** pack up the good properties of the approximation into - the notion of an extensional functor *) -Record EFct (X:k1) : Type := mkEFct - { m : mon X; - e : ext m; - f1 : fct1 m; - f2 : fct2 m }. - -(** preservation of extensional functors *) -Definition pEFct (F:k2) : Type := - forall (X:k1), EFct X -> EFct (F X). - - -(** we show some closure properties of pEFct, depending on such properties - for EFct *) - -Definition moncomp (X Y:k1)(mX:mon X)(mY:mon Y): mon (fun A => X(Y A)). -Proof. - red. - intros A B f x. - exact (mX (Y A)(Y B) (mY A B f) x). -Defined. - -(** closure under composition *) -Lemma compEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X(Y A)). -Proof. - intros ef1 ef2. - apply (mkEFct(m:=moncomp (m ef1) (m ef2))); red; intros; unfold moncomp. -(* prove ext *) - apply (e ef1). - intro. - apply (e ef2); trivial. -(* prove fct1 *) - rewrite (e ef1 (m ef2 (id (A:=A))) (id(A:=Y A))). - apply (f1 ef1). - intro. - apply (f1 ef2). -(* prove fct2 *) - rewrite (e ef1 (m ef2 (g o f))((m ef2 g)o(m ef2 f))). - apply (f2 ef1). - intro. - unfold comp at 2. - apply (f2 ef2). -Defined. - -Corollary comppEFct (F G:k2): pEFct F -> pEFct G -> - pEFct (fun X A => F X (G X A)). -Proof. - red. - intros. - apply compEFct; auto. -Defined. - -(** closure under sums *) -Lemma sumEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X A + Y A)%type. -Proof. - intros ef1 ef2. - set (m12:=fun (A B:Set)(f:A->B) x => match x with - | inl y => inl _ (m ef1 f y) - | inr y => inr _ (m ef2 f y) - end). - apply (mkEFct(m:=m12)); red; intros. -(* prove ext *) - destruct r. - simpl. - apply (f_equal (fun x=>inl (A:=X B) (Y B) x)). - apply (e ef1); trivial. - simpl. - apply (f_equal (fun x=>inr (X B) (B:=Y B) x)). - apply (e ef2); trivial. -(* prove fct1 *) - destruct x. - simpl. - apply (f_equal (fun x=>inl (A:=X A) (Y A) x)). - apply (f1 ef1). - simpl. - apply (f_equal (fun x=>inr (X A) (B:=Y A) x)). - apply (f1 ef2). -(* prove fct2 *) - destruct x. - simpl. - rewrite (f2 ef1); reflexivity. - simpl. - rewrite (f2 ef2); reflexivity. -Defined. - -Corollary sumpEFct (F G:k2): pEFct F -> pEFct G -> - pEFct (fun X A => F X A + G X A)%type. -Proof. - red. - intros. - apply sumEFct; auto. -Defined. - -(** closure under products *) -Lemma prodEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X A * Y A)%type. -Proof. - intros ef1 ef2. - set (m12:=fun (A B:Set)(f:A->B) x => match x with - (x1,x2) => (m ef1 f x1, m ef2 f x2) end). - apply (mkEFct(m:=m12)); red; intros. -(* prove ext *) - destruct r as [x1 x2]. - simpl. - apply injective_projections; simpl. - apply (e ef1); trivial. - apply (e ef2); trivial. -(* prove fct1 *) - destruct x as [x1 x2]. - simpl. - apply injective_projections; simpl. - apply (f1 ef1). - apply (f1 ef2). -(* prove fct2 *) - destruct x as [x1 x2]. - simpl. - apply injective_projections; simpl. - apply (f2 ef1). - apply (f2 ef2). -Defined. - -Corollary prodpEFct (F G:k2): pEFct F -> pEFct G -> - pEFct (fun X A => F X A * G X A)%type. -Proof. - red. - intros. - apply prodEFct; auto. -Defined. - -(** the identity in k2 preserves extensional functors *) -Lemma idpEFct: pEFct (fun X => X). -Proof. - red. - intros. - assumption. -Defined. - -(** a variant for the eta-expanded identity *) -Lemma idpEFct_eta: pEFct (fun X A => X A). -Proof. - red. - intros X ef. - destruct ef as [m0 e0 f01 f02]. - change (mon X) with (mon (fun A => X A)) in m0. - apply (mkEFct (m:=m0) e0 f01 f02). -Defined. - -(** the identity in k1 "is" an extensional functor *) -Lemma idEFct: EFct (fun A => A). -Proof. - set (mId:=fun A B (f:A->B)(x:A) => f x). - apply (mkEFct(m:=mId)). - red. - intros. - unfold mId. - apply H. - red. - reflexivity. - red. - reflexivity. -Defined. - -(** constants in k2 *) -Lemma constpEFct (X:k1): EFct X -> pEFct (fun _ => X). -Proof. - red. - intros. - assumption. -Defined. - -(** constants in k1 *) -Lemma constEFct (C:Set): EFct (fun _ => C). -Proof. - set (mC:=fun A B (f:A->B)(x:C) => x). - apply (mkEFct(m:=mC)); red; intros; unfold mC; reflexivity. -Defined. - - -(** the option type *) -Lemma optionEFct: EFct (fun (A:Set) => option A). - apply (mkEFct (X:=fun (A:Set) => option A)(m:=option_map)); red; intros. - destruct r. - simpl. - rewrite H. - reflexivity. - reflexivity. - destruct x; reflexivity. - destruct x; reflexivity. -Defined. - - -(** natural transformations from (X,mX) to (Y,mY) *) -Definition NAT(X Y:k1)(j:X c_k1 Y)(mX:mon X)(mY:mon Y) : Prop := - forall (A B:Set)(f:A->B)(t:X A), j B (mX A B f t) = mY _ _ f (j A t). - - -Module Type LNMIt_Type. - -Parameter F:k2. -Parameter FpEFct: pEFct F. -Parameter mu20: k1. -Definition mu2: k1:= fun A => mu20 A. -Parameter mapmu2: mon mu2. -Definition MItType: Type := - forall G : k1, (forall X : k1, X c_k1 G -> F X c_k1 G) -> mu2 c_k1 G. -Parameter MIt0 : MItType. -Definition MIt : MItType:= fun G s A t => MIt0 s t. -Definition InType : Type := - forall (X:k1)(ef:EFct X)(j: X c_k1 mu2), - NAT j (m ef) mapmu2 -> F X c_k1 mu2. -Parameter In : InType. -Axiom mapmu2Red : forall (A:Set)(X:k1)(ef:EFct X)(j: X c_k1 mu2) - (n: NAT j (m ef) mapmu2)(t: F X A)(B:Set)(f:A->B), - mapmu2 f (In ef n t) = In ef n (m (FpEFct ef) f t). -Axiom MItRed : forall (G : k1) - (s : forall X : k1, X c_k1 G -> F X c_k1 G)(X : k1)(ef:EFct X)(j: X c_k1 mu2) - (n: NAT j (m ef) mapmu2)(A:Set)(t:F X A), - MIt s (In ef n t) = s X (fun A => (MIt s (A:=A)) o (j A)) A t. -Definition mu2IndType : Prop := - forall (P : (forall A : Set, mu2 A -> Prop)), - (forall (X : k1)(ef:EFct X)(j : X c_k1 mu2)(n: NAT j (m ef) mapmu2), - (forall (A : Set) (x : X A), P A (j A x)) -> - forall (A:Set)(t : F X A), P A (In ef n t)) -> - forall (A : Set) (r : mu2 A), P A r. -Axiom mu2Ind : mu2IndType. - -End LNMIt_Type. - -(** BushDepPredShort.v Version 0.2 July 2008 *) -(** does not need impredicative Set, produces stack overflow under V8.2, tested -with SVN 11296 *) - -(** Copyright Ralph Matthes, I.R.I.T., C.N.R.S. & University of Toulouse *) - -Set Implicit Arguments. - -Require Import List. - -Definition listk1 (A:Set) : Set := list A. -Open Scope type_scope. - -Definition BushF(X:k1)(A:Set) := unit + A * X (X A). - -Definition bushpEFct : pEFct BushF. -Proof. - unfold BushF. - apply sumpEFct. - apply constpEFct. - apply constEFct. - apply prodpEFct. - apply constpEFct. - apply idEFct. - apply comppEFct. - apply idpEFct. - apply idpEFct_eta. -Defined. - -Module Type BUSH := LNMIt_Type with Definition F:=BushF - with Definition FpEFct := -bushpEFct. - -Module Bush (BushBase:BUSH). - -Definition Bush : k1 := BushBase.mu2. - -Definition bush : mon Bush := BushBase.mapmu2. - -End Bush. - - -Definition Id : k1 := fun X => X. - -Fixpoint Pow (X:k1)(k:nat){struct k}:k1:= - match k with 0 => Id - | S k' => fun A => X (Pow X k' A) - end. - -Fixpoint POW (k:nat)(X:k1)(m:mon X){struct k} : mon (Pow X k) := - match k return mon (Pow X k) - with 0 => fun _ _ f => f - | S k' => fun _ _ f => m _ _ (POW k' m f) - end. - -Module Type BushkToList_Type. - -Declare Module Import BP: BUSH. -Definition F:=BushF. -Definition FpEFct:= bushpEFct. -Definition mu20 := mu20. -Definition mu2 := mu2. -Definition mapmu2 := mapmu2. -Definition MItType:= MItType. -Definition MIt0 := MIt0. -Definition MIt := MIt. -Definition InType := InType. -Definition In := In. -Definition mapmu2Red:=mapmu2Red. -Definition MItRed:=MItRed. -Definition mu2IndType:=mu2IndType. -Definition mu2Ind:=mu2Ind. - -Definition Bush:= mu2. -Module BushM := Bush BP. - -Parameter BushkToList: forall(k:nat)(A:k0)(t:Pow Bush k A), list A. -Axiom BushkToList0: forall(A:k0)(t:Pow Bush 0 A), BushkToList 0 A t = t::nil. - -End BushkToList_Type. - -Module BushDep (BushkToListM:BushkToList_Type). - -Module Bush := Bush BushkToListM. - -Import Bush. -Import BushkToListM. - - -Lemma BushkToList0NAT: NAT(Y:=listk1) (BushkToList 0) (POW 0 bush) map. -Proof. - red. - intros. - simpl. - rewrite BushkToList0. -(* stack overflow for coqc and coqtop *) - - -Abort. diff --git a/test-suite/bugs/closed/1925.v b/test-suite/bugs/closed/1925.v deleted file mode 100644 index 4caee1c36d..0000000000 --- a/test-suite/bugs/closed/1925.v +++ /dev/null @@ -1,22 +0,0 @@ -(* Check that the analysis of projectable rel's in an evar instance is up to - aliases *) - -Require Import List. - -Definition compose (A B C : Type) (g : B -> C) (f : A -> B) : A -> C := - fun x : A => g(f x). - -Definition map_fuse' : - forall (A B C : Type) (g : B -> C) (f : A -> B) (xs : list A), - (map g (map f xs)) = map (compose _ _ _ g f) xs - := - fun A B C g f => - (fix loop (ys : list A) {struct ys} := - match ys as ys return (map g (map f ys)) = map (compose _ _ _ g f) ys - with - | nil => refl_equal nil - | x :: xs => - match loop xs in eq _ a return eq _ ((g (f x)) :: a) with - | refl_equal => refl_equal (map g (map f (x :: xs))) - end - end). diff --git a/test-suite/bugs/closed/1931.v b/test-suite/bugs/closed/1931.v deleted file mode 100644 index 930ace1d55..0000000000 --- a/test-suite/bugs/closed/1931.v +++ /dev/null @@ -1,29 +0,0 @@ - - -Set Implicit Arguments. - -Inductive T (A:Set) : Set := - app : T A -> T A -> T A. - -Fixpoint map (A B:Set)(f:A->B)(t:T A) : T B := - match t with - app t1 t2 => app (map f t1)(map f t2) - end. - -Fixpoint subst (A B:Set)(f:A -> T B)(t:T A) :T B := - match t with - app t1 t2 => app (subst f t1)(subst f t2) - end. - -(* This is the culprit: *) -Definition k0:=Set. - -(** interaction of subst with map *) -Lemma substLaw1 (A:k0)(B C:Set)(f: A -> B)(g:B -> T C)(t: T A): - subst g (map f t) = subst (fun x => g (f x)) t. -Proof. - intros. - generalize B C f g; clear B C f g. - induction t; intros; simpl. - f_equal. -Admitted. diff --git a/test-suite/bugs/closed/1935.v b/test-suite/bugs/closed/1935.v deleted file mode 100644 index d583761985..0000000000 --- a/test-suite/bugs/closed/1935.v +++ /dev/null @@ -1,21 +0,0 @@ -Definition f (n:nat) := n = n. - -Lemma f_refl : forall n , f n. -intros. reflexivity. -Qed. - -Definition f' (x:nat) (n:nat) := n = n. - -Lemma f_refl' : forall n , f' n n. -Proof. - intros. reflexivity. -Qed. - -Require Import ZArith. - -Definition f'' (a:bool) := if a then eq (A:= Z) else Z.lt. - -Lemma f_refl'' : forall n , f'' true n n. -Proof. - intro. reflexivity. -Qed. diff --git a/test-suite/bugs/closed/1939.v b/test-suite/bugs/closed/1939.v deleted file mode 100644 index 7b430ace5e..0000000000 --- a/test-suite/bugs/closed/1939.v +++ /dev/null @@ -1,19 +0,0 @@ -Require Import Setoid Program.Basics. - - Parameter P : nat -> Prop. - Parameter R : nat -> nat -> Prop. - - Add Parametric Morphism : P - with signature R ++> impl as PM1. - Admitted. - - Add Parametric Morphism : P - with signature R --> impl as PM2. - Admitted. - - Goal forall x y, R x y -> P y -> P x. - Proof. - intros x y H1 H2. - rewrite H1. - auto. - Qed. diff --git a/test-suite/bugs/closed/1944.v b/test-suite/bugs/closed/1944.v deleted file mode 100644 index ee2918c6e9..0000000000 --- a/test-suite/bugs/closed/1944.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Test some uses of ? in introduction patterns *) - -Inductive J : nat -> Prop := - | K : forall p, J p -> (True /\ True) -> J (S p). - -Lemma bug : forall n, J n -> J (S n). -Proof. - intros ? H. - induction H as [? ? [? ?]]. diff --git a/test-suite/bugs/closed/1951.v b/test-suite/bugs/closed/1951.v deleted file mode 100644 index e950554c4b..0000000000 --- a/test-suite/bugs/closed/1951.v +++ /dev/null @@ -1,63 +0,0 @@ - -(* First a simplification of the bug *) - -Set Printing Universes. - -Inductive enc (A:Type (*1*)) (* : Type.1 *) := C : A -> enc A. - -Definition id (X:Type(*4*)) (x:X) := x. - -Lemma test : let S := Type(*5 : 6*) in enc S -> S. -simpl; intros. -refine (enc _). -apply id. -apply Prop. -Defined. - -(* Then the original bug *) - -Require Import List. - -Inductive a : Set := (* some dummy inductive *) -b : (list a) -> a. (* i don't know if this *) - (* happens for smaller *) - (* ones *) - -Inductive sg : Type := Sg. (* single *) - -Definition ipl2 (P : a -> Type) := (* in Prop, that means P is true forall *) - fold_right (fun x => fun A => prod (P x) A) sg. (* the elements of a given list *) - -Definition ind - : forall S : a -> Type, - (forall ls : list a, ipl2 S ls -> S (b ls)) -> forall s : a, S s := -fun (S : a -> Type) - (X : forall ls : list a, ipl2 S ls -> S (b ls)) => -fix ind2 (s : a) := -match s as a return (S a) with -| b l => - X l - (list_rect (fun l0 : list a => ipl2 S l0) Sg - (fun (a0 : a) (l0 : list a) (IHl : ipl2 S l0) => - pair (ind2 a0) IHl) l) -end. (* some induction principle *) - -Arguments ind [S]. - -Lemma k : a -> Type. (* some ininteresting lemma *) -intro;pattern H;apply ind;intros. - assert (K : Type). - induction ls. - exact sg. - exact sg. - exact (prod K sg). -Defined. - -Lemma k' : a -> Type. (* same lemma but with our bug *) -intro;pattern H;apply ind;intros. - refine (prod _ _). - induction ls. - exact sg. - exact sg. - exact sg. (* Proof complete *) -Defined. (* bug *) diff --git a/test-suite/bugs/closed/1962.v b/test-suite/bugs/closed/1962.v deleted file mode 100644 index 37b0dde06d..0000000000 --- a/test-suite/bugs/closed/1962.v +++ /dev/null @@ -1,55 +0,0 @@ -(* Bug 1962.v - -Bonjour, - -J'ai un exemple de lemme que j'arrivais à prouver avec fsetdec avec la 8.2beta3 -avec la beta4 et la version svn 11447 branche 8.2 çà diverge. - -Voici l'exemple en question, l'exmple test2 marche bien dans les deux version, -test en revanche pose probleme: - -*) - -Require Export FSets. - -(** This module takes a decidable type and -build finite sets of this type, tactics and defs *) - -Module BuildFSets (DecPoints: UsualDecidableType). - -Module Export FiniteSetsOfPoints := FSetWeakList.Make DecPoints. -Module Export FiniteSetsOfPointsProperties := - WProperties FiniteSetsOfPoints. -Module Export Dec := WDecide FiniteSetsOfPoints. -Module Export FM := Dec.F. - -Definition set_of_points := t. -Definition Point := DecPoints.t. - -Definition couple(x y :Point) : set_of_points := -add x (add y empty). - -Definition triple(x y t :Point): set_of_points := -add x (add y (add t empty)). - -Lemma test : forall P A B C A' B' C', -Equal -(union (singleton P) (union (triple A B C) (triple A' B' C'))) -(union (triple P B B') (union (couple P A) (triple C A' C'))). -Proof. -intros. -unfold triple, couple. -Time fsetdec. (* works in 8.2 beta 3, not in beta 4 and final 8.2 *) - (* appears to works again in 8.3 and trunk, take 4-6 seconds *) -Qed. - -Lemma test2 : forall A B C, -Equal - (union (singleton C) (couple A B)) (triple A B C). -Proof. -intros. -unfold triple, couple. -Time fsetdec. -Qed. - -End BuildFSets. diff --git a/test-suite/bugs/closed/1963.v b/test-suite/bugs/closed/1963.v deleted file mode 100644 index 11e2ee44d6..0000000000 --- a/test-suite/bugs/closed/1963.v +++ /dev/null @@ -1,19 +0,0 @@ -(* Check that "dependent inversion" behaves correctly w.r.t to universes *) - -Require Import Eqdep. - -Set Implicit Arguments. - -Inductive illist(A:Type) : nat -> Type := - illistn : illist A 0 -| illistc : forall n:nat, A -> illist A n -> illist A (S n). - -Inductive isig (A:Type)(P:A -> Type) : Type := - iexists : forall x : A, P x -> isig P. - -Lemma inv : forall (A:Type)(n n':nat)(ts':illist A n'), n' = S n -> - isig (fun t => isig (fun ts => - eq_dep nat (fun n => illist A n) n' ts' (S n) (illistc t ts))). -Proof. -intros. -dependent inversion ts'. diff --git a/test-suite/bugs/closed/1977.v b/test-suite/bugs/closed/1977.v deleted file mode 100644 index 28715040ce..0000000000 --- a/test-suite/bugs/closed/1977.v +++ /dev/null @@ -1,4 +0,0 @@ -Inductive T {A} : Prop := c : A -> T. -Goal (@T nat). -apply c. exact 0. -Qed. diff --git a/test-suite/bugs/closed/1981.v b/test-suite/bugs/closed/1981.v deleted file mode 100644 index a3d9429307..0000000000 --- a/test-suite/bugs/closed/1981.v +++ /dev/null @@ -1,5 +0,0 @@ -Arguments ex_intro [A]. - -Goal exists n : nat, True. - eapply ex_intro. exact 0. exact I. -Qed. diff --git a/test-suite/bugs/closed/2001.v b/test-suite/bugs/closed/2001.v deleted file mode 100644 index 652c65706a..0000000000 --- a/test-suite/bugs/closed/2001.v +++ /dev/null @@ -1,22 +0,0 @@ -(* Automatic computing of guard in "Theorem with"; check that guard is not - computed when the user explicitly indicated it *) - -Unset Automatic Introduction. - -Inductive T : Set := -| v : T. - -Definition f (s:nat) (t:T) : nat. -fix f 2. -intros s t. -refine - match t with - | v => s - end. -Defined. - -Lemma test : - forall s, f s v = s. -Proof. -reflexivity. -Qed. diff --git a/test-suite/bugs/closed/2006.v b/test-suite/bugs/closed/2006.v deleted file mode 100644 index d353d0e2d6..0000000000 --- a/test-suite/bugs/closed/2006.v +++ /dev/null @@ -1,23 +0,0 @@ -(* Take the type constraint on Record into account *) - -Definition Type1 := Type. -Fail Record R : Type1 := { p:Type1 }. (* was accepted before trunk revision 11619 *) - -(* -Remarks: - -- The behaviour was inconsistent with the one of Inductive, e.g. - - Inductive R : Type1 := Build_R : Type1 -> R. - - was correctly refused. - -- CoRN makes some use of the following configuration: - - Definition CProp := Type. - Record R : CProp := { ... }. - - CoRN may have to change the CProp definition into a notation if the - preservation of the former semantics of Record type constraints - turns to be required. -*) diff --git a/test-suite/bugs/closed/2016.v b/test-suite/bugs/closed/2016.v deleted file mode 100644 index 536e6fabd9..0000000000 --- a/test-suite/bugs/closed/2016.v +++ /dev/null @@ -1,64 +0,0 @@ -(* Coq 8.2beta4 *) -Require Import Classical_Prop. - -Unset Structural Injection. - -Record coreSemantics : Type := CoreSemantics { - core: Type; - corestep: core -> core -> Prop; - corestep_fun: forall q q1 q2, corestep q q1 -> corestep q q2 -> q1 = q2 -}. - -Definition state : Type := {sem: coreSemantics & sem.(core)}. - -Inductive step: state -> state -> Prop := - | step_core: forall sem st st' - (Hcs: sem.(corestep) st st'), - step (existT _ sem st) (existT _ sem st'). - -Lemma step_fun: forall st1 st2 st2', step st1 st2 -> step st1 st2' -> st2 = st2'. -Proof. -intros. -inversion H; clear H; subst. inversion H0; clear H0; subst; auto. -generalize (inj_pairT2 _ _ _ _ _ H2); clear H2; intro; subst. -rewrite (corestep_fun _ _ _ _ Hcs Hcs0); auto. -Qed. - -Record oe_core := oe_Core { - in_core: Type; - in_corestep: in_core -> in_core -> Prop; - in_corestep_fun: forall q q1 q2, in_corestep q q1 -> in_corestep q q2 -> q1 = q2; - in_q: in_core -}. - -Definition oe2coreSem (oec : oe_core) : coreSemantics := - CoreSemantics oec.(in_core) oec.(in_corestep) oec.(in_corestep_fun). - -Definition oe_corestep (q q': oe_core) := - step (existT _ (oe2coreSem q) q.(in_q)) (existT _ (oe2coreSem q') q'.(in_q)). - -Lemma inj_pairT1: forall (U: Type) (P: U -> Type) (p1 p2: U) x y, - existT P p1 x = existT P p2 y -> p1=p2. -Proof. intros; injection H; auto. -Qed. - -Definition f := CoreSemantics oe_core. - -Lemma oe_corestep_fun: forall q q1 q2, - oe_corestep q q1 -> oe_corestep q q2 -> q1 = q2. -Proof. -unfold oe_corestep; intros. -assert (HH:= step_fun _ _ _ H H0); clear H H0. -destruct q1; destruct q2; unfold oe2coreSem; simpl in *. -generalize (inj_pairT1 _ _ _ _ _ _ HH); clear HH; intros. -injection H. -revert in_q1 in_corestep1 in_corestep_fun1 - H. -pattern in_core1. -apply eq_ind_r with (x := in_core0). -admit. -apply sym_eq. -(** good to here **) -Show Universes. -Print Universes. -Fail apply H0. diff --git a/test-suite/bugs/closed/2017.v b/test-suite/bugs/closed/2017.v deleted file mode 100644 index df6661483a..0000000000 --- a/test-suite/bugs/closed/2017.v +++ /dev/null @@ -1,15 +0,0 @@ -(* Some check of Miller's pattern inference - used to fail in 8.2 due - first to the presence of aliases, secondly due to the absence of - restriction of the potential interesting variables to the subset of - variables effectively occurring in the term to instantiate *) - -Set Implicit Arguments. - -Variable choose : forall(P : bool -> Prop)(H : exists x, P x), bool. - -Variable H : exists x : bool, True. - -Definition coef := -match Some true with - Some _ => @choose _ H |_ => true -end . diff --git a/test-suite/bugs/closed/2021.v b/test-suite/bugs/closed/2021.v deleted file mode 100644 index 5df92998e1..0000000000 --- a/test-suite/bugs/closed/2021.v +++ /dev/null @@ -1,25 +0,0 @@ -(* correct failure of injection/discriminate on types whose inductive - status derives from the substitution of an argument *) - -Unset Structural Injection. - -Inductive t : nat -> Type := -| M : forall n: nat, nat -> t n. - -Lemma eq_t : forall n n' m m', - existT (fun B : Type => B) (t n) (M n m) = - existT (fun B : Type => B) (t n') (M n' m') -> True. -Proof. - intros. - injection H. - intro Ht. - exact I. -Qed. - -Lemma eq_t' : forall n n' : nat, - existT (fun B : Type => B) (t n) (M n 0) = - existT (fun B : Type => B) (t n') (M n' 1) -> True. -Proof. - intros. - discriminate H || exact I. -Qed. diff --git a/test-suite/bugs/closed/2027.v b/test-suite/bugs/closed/2027.v deleted file mode 100644 index ebc2bc070c..0000000000 --- a/test-suite/bugs/closed/2027.v +++ /dev/null @@ -1,11 +0,0 @@ - -Parameter T : Type -> Type. -Parameter f : forall {A}, T A -> T A. -Parameter P : forall {A}, T A -> Prop. -Axiom f_id : forall {A} (l : T A), f l = l. - -Goal forall A (p : T A), P p. -Proof. - intros. - rewrite <- f_id. -Admitted. diff --git a/test-suite/bugs/closed/2083.v b/test-suite/bugs/closed/2083.v deleted file mode 100644 index 5f17f7af35..0000000000 --- a/test-suite/bugs/closed/2083.v +++ /dev/null @@ -1,27 +0,0 @@ -Require Import Program Arith. - -Program Fixpoint check_n (n : nat) (P : { i | i < n } -> bool) (p : nat) - (H : forall (i : { i | i < n }), i < p -> P i = true) - {measure (n - p)} : - Exc (forall (p : { i | i < n}), P p = true) := - match le_lt_dec n p with - | left _ => value _ - | right cmp => - if dec (P p) then - check_n n P (S p) _ - else - error - end. - -Require Import Omega. - -Solve Obligations with program_simpl ; auto with *; try omega. - -Next Obligation. - apply H. simpl. omega. -Defined. - -Next Obligation. - case (le_lt_dec p i) ; intros. assert(i = p) by omega. subst. - revert H0. clear_subset_proofs. auto. - apply H. simpl. assumption. Defined. diff --git a/test-suite/bugs/closed/2089.v b/test-suite/bugs/closed/2089.v deleted file mode 100644 index aebccc9424..0000000000 --- a/test-suite/bugs/closed/2089.v +++ /dev/null @@ -1,17 +0,0 @@ -Inductive even (x: nat): nat -> Prop := - | even_base: even x O - | even_succ: forall n, odd x n -> even x (S n) - -with odd (x: nat): nat -> Prop := - | odd_succ: forall n, even x n -> odd x (S n). - -Scheme even_ind2 := Minimality for even Sort Prop - with odd_ind2 := Minimality for odd Sort Prop. - -Combined Scheme even_odd_ind from even_ind2, odd_ind2. - -Check (even_odd_ind :forall (x : nat) (P P0 : nat -> Prop), - P 0 -> - (forall n : nat, odd x n -> P0 n -> P (S n)) -> - (forall n : nat, even x n -> P n -> P0 (S n)) -> - (forall n : nat, even x n -> P n) /\ (forall n : nat, odd x n -> P0 n)). diff --git a/test-suite/bugs/closed/2095.v b/test-suite/bugs/closed/2095.v deleted file mode 100644 index 28ea99dfef..0000000000 --- a/test-suite/bugs/closed/2095.v +++ /dev/null @@ -1,19 +0,0 @@ -(* Classes and sections *) - -Section OPT. - Variable A: Type. - - Inductive MyOption: Type := - | MyNone: MyOption - | MySome: A -> MyOption. - - Class Opt: Type := { - f_opt: A -> MyOption - }. -End OPT. - -Definition f_nat (n: nat): MyOption nat := MySome _ n. - -Instance Nat_Opt: Opt nat := { - f_opt := f_nat -}. diff --git a/test-suite/bugs/closed/2105.v b/test-suite/bugs/closed/2105.v deleted file mode 100644 index 46a416fd4b..0000000000 --- a/test-suite/bugs/closed/2105.v +++ /dev/null @@ -1,2 +0,0 @@ - -Definition id (T:Type) := Eval vm_compute in T. diff --git a/test-suite/bugs/closed/2108.v b/test-suite/bugs/closed/2108.v deleted file mode 100644 index cad8baa981..0000000000 --- a/test-suite/bugs/closed/2108.v +++ /dev/null @@ -1,22 +0,0 @@ -(* Declare Module in Module Type *) -Module Type A. -Record t : Set := { something : unit }. -End A. - - -Module Type B. -Declare Module BA : A. -End B. - - -Module Type C. -Declare Module CA : A. -Declare Module CB : B with Module BA := CA. -End C. - - -Module Type D. -Declare Module DA : A. -(* Next line gives: "Anomaly: uncaught exception Not_found. Please report." *) -Declare Module DC : C with Module CA := DA. -End D. diff --git a/test-suite/bugs/closed/2117.v b/test-suite/bugs/closed/2117.v deleted file mode 100644 index 6377a8b74a..0000000000 --- a/test-suite/bugs/closed/2117.v +++ /dev/null @@ -1,56 +0,0 @@ -(* Check pattern-unification on evars in apply unification *) - -Axiom app : forall tau tau':Type, (tau -> tau') -> tau -> tau'. - -Axiom copy : forall tau:Type, tau -> tau -> Prop. -Axiom copyr : forall tau:Type, tau -> tau -> Prop. -Axiom copyf : forall tau:Type, tau -> tau -> Prop. -Axiom eq : forall tau:Type, tau -> tau -> Prop. -Axiom subst : forall tau tau':Type, (tau -> tau') -> tau -> tau' -> Prop. - -Axiom copy_atom : forall tau:Type, forall t t':tau, eq tau t t' -> copy tau t t'. -Axiom copy_fun: forall tau tau':Type, forall t t':(tau->tau'), -(forall x:tau, copyr tau x x->copy tau' (t x) (t' x)) -->copy (tau->tau') t t'. - -Axiom copyr_atom : forall tau:Type, forall t t':tau, copyr tau t t' -> eq tau t t'. -Axiom copyr_fun: forall tau tau':Type, forall t t':(tau->tau'), -copyr (tau->tau') t t' -->(forall x y:tau, copy tau x y->copyr tau' (t x) (t' y)). - -Axiom copyf_atom : forall tau:Type, forall t t':tau, copyf tau t t' -> eq tau t t'. -Axiom copyf_fun: forall tau tau':Type, forall t t':(tau->tau'), -copyr (tau->tau') t t' -->(forall x y:tau, forall z1 z2:tau', -(copy tau x y)-> -(subst tau tau' t x z1)-> -(subst tau tau' t' y z2)-> -copyf tau' z1 z2). - -Axiom eqappg: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau',forall t':tau', -( ((subst tau tau' t q t') /\ (eq tau' t' r)) -->eq tau' (app tau tau' t q) r). - -Axiom eqappd: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau', -forall t':tau', ((subst tau tau' t q t') /\ (eq tau' r t')) -->eq tau' r (app tau tau' t q). - -Axiom substcopy: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau', -(forall x:tau, (copyf tau x q) -> (copy tau' (t x) r)) -->subst tau tau' t q r. - -Ltac EtaLong := (apply copy_fun;intros;EtaLong)|| apply copy_atom. -Ltac Subst := apply substcopy;intros;EtaLong. -Ltac Rigid_aux := fun A => apply A|| Rigid_aux (copyr_fun _ _ _ _ A). -Ltac Rigid := fun A => apply copyr_atom; Rigid_aux A. - -Theorem church0: forall i:Type, exists X:(i->i)->i->i, -copy ((i->i)->i->i) (fun f:i->i => fun x:i=>f (X f x)) (fun f:i->i=>fun x:i=>app i i (X f) (f x)). -intros. -esplit. -EtaLong. -eapply eqappd;split. -Subst. -apply copyf_atom. -Show Existentials. -apply H1. diff --git a/test-suite/bugs/closed/2123.v b/test-suite/bugs/closed/2123.v deleted file mode 100644 index 422a2c126e..0000000000 --- a/test-suite/bugs/closed/2123.v +++ /dev/null @@ -1,11 +0,0 @@ -(* About the detection of non-dependent metas by the refine tactic *) - -(* The following is a simplification of bug #2123 *) - -Parameter fset : nat -> Set. -Parameter widen : forall (n : nat) (s : fset n), { x : fset (S n) | s=s }. -Goal forall i, fset (S i). -intro. -refine (proj1_sig (widen i _)). - - diff --git a/test-suite/bugs/closed/2127.v b/test-suite/bugs/closed/2127.v deleted file mode 100644 index 142ada268b..0000000000 --- a/test-suite/bugs/closed/2127.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Check that "apply eq_refl" is not exported as an interactive - tactic but as a statically globalized one *) - -(* (this is a simplification of the original bug report) *) - -Module A. -Hint Rewrite eq_sym using apply eq_refl : foo. -End A. diff --git a/test-suite/bugs/closed/2135.v b/test-suite/bugs/closed/2135.v deleted file mode 100644 index 61882176aa..0000000000 --- a/test-suite/bugs/closed/2135.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Check that metas are whd-normalized before trying 2nd-order unification *) -Lemma test : - forall (D:Type) (T : forall C, option C) (Q:forall D, option D -> Prop), - (forall (A : Type) (P : forall B:Type, option B -> Prop), P A (T A)) - -> Q D (T D). -Proof. - intros D T Q H. - pattern (T D). apply H. -Qed. diff --git a/test-suite/bugs/closed/2136.v b/test-suite/bugs/closed/2136.v deleted file mode 100644 index 2fcfbe40dc..0000000000 --- a/test-suite/bugs/closed/2136.v +++ /dev/null @@ -1,61 +0,0 @@ -(* Bug #2136 - -The fsetdec tactic seems to get confused by hypotheses like - HeqH1 : H1 = MkEquality s0 s1 b -If I clear them then it is able to solve my goal; otherwise it is not. -I would expect it to be able to solve the goal even without this hypothesis -being cleared. A small, self-contained example is below. - -I have coq r12238. - - -Thanks -Ian -*) - - -Require Import FSets. -Require Import Arith. -Require Import FSetWeakList. - -Module DecidableNat. -Definition t := nat. -Definition eq := @eq nat. -Definition eq_refl := @refl_equal nat. -Definition eq_sym := @sym_eq nat. -Definition eq_trans := @trans_eq nat. -Definition eq_dec := eq_nat_dec. -End DecidableNat. - -Module NatSet := Make(DecidableNat). - -Module Export Dec := WDecide (NatSet). -Import FSetDecideAuxiliary. - -Parameter MkEquality : forall ( s0 s1 : NatSet.t ) - ( x : nat ), - NatSet.Equal s1 (NatSet.add x s0). - -Lemma ThisLemmaWorks : forall ( s0 s1 : NatSet.t ) - ( a b : nat ), - NatSet.In a s0 - -> NatSet.In a s1. -Proof. -intros. -remember (MkEquality s0 s1 b) as H1. -clear HeqH1. -fsetdec. -Qed. - -Lemma ThisLemmaWasFailing : forall ( s0 s1 : NatSet.t ) - ( a b : nat ), - NatSet.In a s0 - -> NatSet.In a s1. -Proof. -intros. -remember (MkEquality s0 s1 b) as H1. -fsetdec. -(* -Error: Tactic failure: because the goal is beyond the scope of this tactic. -*) -Qed. diff --git a/test-suite/bugs/closed/2137.v b/test-suite/bugs/closed/2137.v deleted file mode 100644 index b1f54b1766..0000000000 --- a/test-suite/bugs/closed/2137.v +++ /dev/null @@ -1,52 +0,0 @@ -(* Bug #2137 - -The fsetdec tactic is sensitive to which way round the arguments to <> are. -In the small, self-contained example below, it is able to solve the goal -if it knows that "b <> a", but not if it knows that "a <> b". I would expect -it to be able to solve hte goal in either case. - -I have coq r12238. - - -Thanks -Ian - -*) - -Require Import Arith FSets FSetWeakList. - -Module DecidableNat. -Definition t := nat. -Definition eq := @eq nat. -Definition eq_refl := @refl_equal nat. -Definition eq_sym := @sym_eq nat. -Definition eq_trans := @trans_eq nat. -Definition eq_dec := eq_nat_dec. -End DecidableNat. - -Module NatSet := Make(DecidableNat). - -Module Export NameSetDec := WDecide (NatSet). - -Lemma ThisLemmaWorks : forall ( s0 : NatSet.t ) - ( a b : nat ), - b <> a - -> ~(NatSet.In a s0) - -> ~(NatSet.In a (NatSet.add b s0)). -Proof. -intros. -fsetdec. -Qed. - -Lemma ThisLemmaWasFailing : forall ( s0 : NatSet.t ) - ( a b : nat ), - a <> b - -> ~(NatSet.In a s0) - -> ~(NatSet.In a (NatSet.add b s0)). -Proof. -intros. -fsetdec. -(* -Error: Tactic failure: because the goal is beyond the scope of this tactic. -*) -Qed. diff --git a/test-suite/bugs/closed/2139.v b/test-suite/bugs/closed/2139.v deleted file mode 100644 index a7f3550888..0000000000 --- a/test-suite/bugs/closed/2139.v +++ /dev/null @@ -1,24 +0,0 @@ -(* Call of apply on <-> failed because of evars in elimination predicate *) -Generalizable Variables patch. - -Class Patch (patch : Type) := { - commute : patch -> patch -> Prop -}. - -Parameter flip : forall `{patchInstance : Patch patch} - {a b : patch}, - commute a b <-> commute b a. - -Lemma Foo : forall `{patchInstance : Patch patch} - {a b : patch}, - (commute a b) - -> True. -Proof. -intros. -apply flip in H. - -(* failed in well-formed arity check because elimination predicate of - iff in (@flip _ _ _ _) had normalized evars while the ones in the - type of (@flip _ _ _ _) itself had non-normalized evars *) - -(* By the way, is the check necessary ? *) diff --git a/test-suite/bugs/closed/2141.v b/test-suite/bugs/closed/2141.v deleted file mode 100644 index 22e33c8e81..0000000000 --- a/test-suite/bugs/closed/2141.v +++ /dev/null @@ -1,16 +0,0 @@ -Require Coq.extraction.Extraction. -Require Import FSetList. -Require Import OrderedTypeEx. - -Module NatSet := FSetList.Make (Nat_as_OT). -Recursive Extraction NatSet.fold. - -Module FSetHide (X : FSetInterface.S). - Include X. -End FSetHide. - -Module NatSet' := FSetHide NatSet. -Recursive Extraction NatSet'.fold. -Extraction TestCompile NatSet'.fold. - -(* Extraction "test2141.ml" NatSet'.fold. *) diff --git a/test-suite/bugs/closed/2145.v b/test-suite/bugs/closed/2145.v deleted file mode 100644 index 4dc0de7433..0000000000 --- a/test-suite/bugs/closed/2145.v +++ /dev/null @@ -1,20 +0,0 @@ -(* Test robustness of Groebner tactic in presence of disequalities *) - -Require Export Reals. -Require Export Nsatz. - -Open Scope R_scope. - -Lemma essai : - forall yb xb m1 m2 xa ya, - xa <> xb -> - yb - 2 * m2 * xb = ya - m2 * xa -> - yb - m1 * xb = ya - m1 * xa -> - yb - ya = (2 * xb - xa) * m2 -> - yb - ya = (xb - xa) * m1. -Proof. -intros. -(* clear H. groebner used not to work when H was not cleared *) -nsatz. -Qed. - diff --git a/test-suite/bugs/closed/2149.v b/test-suite/bugs/closed/2149.v deleted file mode 100644 index 38c5f36ab2..0000000000 --- a/test-suite/bugs/closed/2149.v +++ /dev/null @@ -1,7 +0,0 @@ -Lemma Foo : forall x y : nat, y = x -> y = x. -Proof. -intros x y. -rename x into y, y into x. -trivial. -Qed. - diff --git a/test-suite/bugs/closed/2164.v b/test-suite/bugs/closed/2164.v deleted file mode 100644 index 6adb3577be..0000000000 --- a/test-suite/bugs/closed/2164.v +++ /dev/null @@ -1,334 +0,0 @@ -(* Check that "inversion as" manages names as expected *) -Inductive type: Set - := | int: type - | pointer: type -> type. -Print type. - -Parameter value_set - : type -> Set. - -Parameter string : Set. - -Parameter Z : Set. - -Inductive lvalue (t: type): Set - := | var: string -> lvalue t (* name of the variable *) - | lvalue_loc: Z -> lvalue t (* address of the variable *) - | deref_l: lvalue (pointer t) -> lvalue t (* deref an lvalue ptr *) - | deref_r: rvalue (pointer t) -> lvalue t (* deref an rvalue ptr *) -with rvalue (t: type): Set - := | value_of: lvalue t -> rvalue t (* variable as value *) - | mk_rvalue: value_set t -> rvalue t. (* literal value *) -Print lvalue. - -Inductive statement: Set - := | void_stat: statement - | var_loc: (* to be destucted at end of scope *) - forall (t: type) (n: string) (loc: Z), statement - | var_ref: (* not to be destructed *) - forall (t: type) (n: string) (loc: Z), statement - | var_def: (* var def as typed in code *) - forall (t:type) (n: string) (val: rvalue t), statement - | assign: - forall (t: type) (var: lvalue t) (val: rvalue t), statement - | group: - forall (l: list statement), statement - | fun_def: - forall (s: string) (l: list statement), statement - | param_decl: - forall (t: type) (n: string), statement - | delete: - forall a: Z, statement. - -Inductive expr: Set -:= | statement_to_expr: statement -> expr - | lvalue_to_expr: forall t: type, lvalue t -> expr - | rvalue_to_expr: forall t: type, rvalue t -> expr. - -Inductive executable_prim_expr: expr -> Set -:= -(* statements *) - | var_def_primitive: - forall (t: type) (n: string) (loc: Z), - executable_prim_expr - (statement_to_expr - (var_def t n - (value_of t (lvalue_loc t loc)))) - | assign_primitive: - forall (t: type) (loc1 loc2: Z), - executable_prim_expr - (statement_to_expr - (assign t (lvalue_loc t loc1) - (value_of t (lvalue_loc t loc2)))) -(* rvalue *) - | mk_rvalue_primitive: - forall (t: type) (v: value_set t), - executable_prim_expr - (rvalue_to_expr t (mk_rvalue t v)) -(* lvalue *) - (* var *) - | var_primitive: - forall (t: type) (n: string), - executable_prim_expr (lvalue_to_expr t (var t n)) - (* deref_l *) - | deref_l_primitive: - forall (t: type) (loc: Z), - executable_prim_expr - (lvalue_to_expr t - (deref_l t (lvalue_loc (pointer t) loc))) - (* deref_r *) - | deref_r_primitive: - forall (t: type) (loc: Z), - executable_prim_expr - (lvalue_to_expr t - (deref_r t - (value_of (pointer t) - (lvalue_loc (pointer t) loc)))). - -Inductive executable_sub_expr: expr -> Set -:= | executable_sub_expr_prim: - forall e: expr, - executable_prim_expr e -> - executable_sub_expr e -(* statements *) - | var_def_sub_rvalue: - forall (t: type) (n: string) (rv: rvalue t), - executable_sub_expr (rvalue_to_expr t rv) -> - executable_sub_expr (statement_to_expr (var_def t n rv)) - | assign_sub_lvalue: - forall (t: type) (lv: lvalue t) (rv: rvalue t), - executable_sub_expr (lvalue_to_expr t lv) -> - executable_sub_expr (statement_to_expr (assign t lv rv)) - | assign_sub_rvalue: - forall (t: type) (lv: lvalue t) (rv: rvalue t), - executable_sub_expr (rvalue_to_expr t rv) -> - executable_sub_expr (statement_to_expr (assign t lv rv)) -(* rvalue *) - | value_of_sub_lvalue: - forall (t: type) (lv: lvalue t), - executable_sub_expr (lvalue_to_expr t lv) -> - executable_sub_expr (rvalue_to_expr t (value_of t lv)) -(* lvalue *) - | deref_l_sub_lvalue: - forall (t: type) (lv: lvalue (pointer t)), - executable_sub_expr (lvalue_to_expr (pointer t) lv) -> - executable_sub_expr (lvalue_to_expr t (deref_l t lv)) - | deref_r_sub_rvalue: - forall (t: type) (rv: rvalue (pointer t)), - executable_sub_expr (rvalue_to_expr (pointer t) rv) -> - executable_sub_expr (lvalue_to_expr t (deref_r t rv)). - -Inductive expr_kind: Set -:= | statement_kind: expr_kind - | lvalue_kind: type -> expr_kind - | rvalue_kind: type -> expr_kind. - -Definition expr_to_kind: expr -> expr_kind. -intro e. -destruct e. -exact statement_kind. -exact (lvalue_kind t). -exact (rvalue_kind t). -Defined. - -Inductive def_sub_expr_subs: - forall e: expr, - forall ee: executable_sub_expr e, - forall ee': expr, - forall e': expr, - Prop -:= | def_sub_expr_subs_prim: - forall e: expr, - forall p: executable_prim_expr e, - forall ee': expr, - expr_to_kind e = expr_to_kind ee' -> - def_sub_expr_subs e (executable_sub_expr_prim e p) ee' ee' - | def_sub_expr_subs_var_def_sub_rvalue: - forall (t: type) (n: string), - forall rv rv': rvalue t, - forall ee': expr, - forall se_rv: executable_sub_expr (rvalue_to_expr t rv), - def_sub_expr_subs (rvalue_to_expr t rv) se_rv ee' - (rvalue_to_expr t rv') -> - def_sub_expr_subs - (statement_to_expr (var_def t n rv)) - (var_def_sub_rvalue t n rv se_rv) - ee' - (statement_to_expr (var_def t n rv')) - | def_sub_expr_subs_assign_sub_lvalue: - forall t: type, - forall lv lv': lvalue t, - forall rv: rvalue t, - forall ee': expr, - forall se_lv: executable_sub_expr (lvalue_to_expr t lv), - def_sub_expr_subs (lvalue_to_expr t lv) se_lv ee' - (lvalue_to_expr t lv') -> - def_sub_expr_subs - (statement_to_expr (assign t lv rv)) - (assign_sub_lvalue t lv rv se_lv) - ee' - (statement_to_expr (assign t lv' rv)) - | def_sub_expr_subs_assign_sub_rvalue: - forall t: type, - forall lv: lvalue t, - forall rv rv': rvalue t, - forall ee': expr, - forall se_rv: executable_sub_expr (rvalue_to_expr t rv), - def_sub_expr_subs (rvalue_to_expr t rv) se_rv ee' - (rvalue_to_expr t rv') -> - def_sub_expr_subs - (statement_to_expr (assign t lv rv)) - (assign_sub_rvalue t lv rv se_rv) - ee' - (statement_to_expr (assign t lv rv')) - | def_sub_expr_subs_value_of_sub_lvalue: - forall t: type, - forall lv lv': lvalue t, - forall ee': expr, - forall se_lv: executable_sub_expr (lvalue_to_expr t lv), - def_sub_expr_subs (lvalue_to_expr t lv) se_lv ee' - (lvalue_to_expr t lv') -> - def_sub_expr_subs - (rvalue_to_expr t (value_of t lv)) - (value_of_sub_lvalue t lv se_lv) - ee' - (rvalue_to_expr t (value_of t lv')) - | def_sub_expr_subs_deref_l_sub_lvalue: - forall t: type, - forall lv lv': lvalue (pointer t), - forall ee': expr, - forall se_lv: executable_sub_expr (lvalue_to_expr (pointer t) lv), - def_sub_expr_subs (lvalue_to_expr (pointer t) lv) se_lv ee' - (lvalue_to_expr (pointer t) lv') -> - def_sub_expr_subs - (lvalue_to_expr t (deref_l t lv)) - (deref_l_sub_lvalue t lv se_lv) - ee' - (lvalue_to_expr t (deref_l t lv')) - | def_sub_expr_subs_deref_r_sub_rvalue: - forall t: type, - forall rv rv': rvalue (pointer t), - forall ee': expr, - forall se_rv: executable_sub_expr (rvalue_to_expr (pointer t) rv), - def_sub_expr_subs (rvalue_to_expr (pointer t) rv) se_rv ee' - (rvalue_to_expr (pointer t) rv') -> - def_sub_expr_subs - (lvalue_to_expr t (deref_r t rv)) - (deref_r_sub_rvalue t rv se_rv) - ee' - (lvalue_to_expr t (deref_r t rv')). - -Lemma type_dec: forall t t': type, {t = t'} + {t <> t'}. -Proof. -intros t. -induction t as [|t IH]. -destruct t'. -tauto. -right. -discriminate. -destruct t'. -right. -discriminate. -destruct (IH t') as [H|H]. -left. -f_equal. -tauto. -right. -injection. -tauto. -Qed. -Check type_dec. - -Definition sigT_get_proof: - forall T: Type, - forall eq_dec_T: forall t t': T, {t = t'} + {~ t = t'}, - forall P: T -> Type, - forall t: T, - P t -> - sigT P -> - P t. -intros T eq_dec_T P t H1 H2. -destruct H2 as [t' H2]. -destruct (eq_dec_T t t') as [H3|H3]. -rewrite H3. -exact H2. -exact H1. -Defined. - -Axiom sigT_get_proof_existT_same: - forall T: Type, - forall eq_dec_T: forall t t': T, {t = t'} + {~ t = t'}, - forall P: T -> Type, - forall t: T, - forall H1 H2: P t, - sigT_get_proof T eq_dec_T P t H1 (existT P t H2) = H2. - -Theorem existT_injective: - forall T, - (forall t1 t2: T, { t1 = t2 } + { t1 <> t2 }) -> - forall P: T -> Type, - forall t: T, - forall pt1 pt2: P t, - existT P t pt1 = existT P t pt2 -> - pt1 = pt2. -Proof. -intros T T_dec P t pt1 pt2 H1. -pose (H2 := f_equal (sigT_get_proof T T_dec P t pt1) H1). -repeat rewrite sigT_get_proof_existT_same in H2. -assumption. -Qed. - -Ltac decide_equality_sub dec x x' H := - destruct (dec x x') as [H|H]; - [subst x'; try tauto|try(right; injection; tauto; fail)]. - -Axiom value_set_dec: - forall t: type, - forall v v': value_set t, - {v = v'} + {v <> v'}. - -Theorem lvalue_dec: - forall (t: type) (l l': lvalue t), {l = l'} + {l <> l'} -with rvalue_dec: - forall (t: type) (r r': rvalue t), {r = r'} + {r <> r'}. -Admitted. - -Theorem sub_expr_subs_same_kind: - forall e: expr, - forall ee: executable_sub_expr e, - forall ee': expr, - forall e': expr, - def_sub_expr_subs e ee ee' e' -> - expr_to_kind e = expr_to_kind e'. -Proof. -intros e ee ee' e' H1. -case H1; try (intros; tauto; fail). -Qed. - -Theorem def_sub_expr_subs_assign_sub_lvalue_inversion: - forall t: type, - forall lv: lvalue t, - forall rv: rvalue t, - forall ee' e': expr, - forall ee_sub: executable_sub_expr (lvalue_to_expr t lv), - def_sub_expr_subs (statement_to_expr (assign t lv rv)) - (assign_sub_lvalue t lv rv ee_sub) ee' e' -> - { lv': lvalue t - | def_sub_expr_subs (lvalue_to_expr t lv) ee_sub ee' - (lvalue_to_expr t lv') - & e' = statement_to_expr (assign t lv' rv) }. -Proof. -intros t lv rv ee' [s'|t' lv''|t' rv''] ee_sub H1; - try discriminate (sub_expr_subs_same_kind _ _ _ _ H1). -destruct s' as [| | | |t' lv'' rv''| | | |]; - try(assert (H2: False); [inversion H1|elim H2]; fail). -destruct (type_dec t t') as [H2|H2]; - [|assert (H3: False); - [|elim H3; fail]]. -2: inversion H1 as [];tauto. -subst t'. -exists lv''. - inversion H1 as - [| |t' lv''' lv'''' rv''' ee'' ee_sub' H2 (H3_1,H3_2,H3_3) (H4_1,H4_2,H4_3,H4_4,H4_5) H5 (H6_1,H6_2)| | | |]. -(* Check that all names are the given ones: *) -clear t' lv''' lv'''' rv''' ee'' ee_sub' H2 H3_1 H3_2 H3_3 H4_1 H4_2 H4_3 H4_4 H4_5 H5 H6_1 H6_2. diff --git a/test-suite/bugs/closed/2181.v b/test-suite/bugs/closed/2181.v deleted file mode 100644 index 62820d8699..0000000000 --- a/test-suite/bugs/closed/2181.v +++ /dev/null @@ -1,3 +0,0 @@ -Class C. -Parameter P: C -> Prop. -Fail Record R: Type := { _: C; u: P _ }. diff --git a/test-suite/bugs/closed/2193.v b/test-suite/bugs/closed/2193.v deleted file mode 100644 index fe2588676d..0000000000 --- a/test-suite/bugs/closed/2193.v +++ /dev/null @@ -1,31 +0,0 @@ -(* Computation of dependencies in the "match" return predicate was incomplete *) -(* Submitted by R. O'Connor, Nov 2009 *) - -Inductive Symbol : Set := - | VAR : Symbol. - -Inductive SExpression := - | atomic : Symbol -> SExpression. - -Inductive ProperExpr : SExpression -> SExpression -> Type := - | pe_3 : forall (x : Symbol) (alpha : SExpression), - ProperExpr alpha (atomic VAR) -> - ProperExpr (atomic x) alpha. - -Definition A (P : forall s : SExpression, Type) - (x alpha alpha1 : SExpression) - (t : ProperExpr (x) alpha1) : option (x = atomic VAR) := - match t as pe in ProperExpr a b return option (a = atomic VAR) with - | pe_3 x0 alpha3 tye' => - (fun (x:Symbol) (alpha : SExpression) => @None (atomic x = atomic VAR)) - x0 alpha3 - end. - -Definition B (P : forall s : SExpression, Type) - (x alpha alpha1 : SExpression) - (t : ProperExpr (x) alpha1) : option (x = atomic VAR) := - match t as pe in ProperExpr a b return option (a = atomic VAR) with - | pe_3 x0 alpha3 tye' => - (fun (x:Symbol) (alpha : SExpression) (t:ProperExpr alpha (atomic VAR)) => @None (atomic x = atomic VAR)) - x0 alpha3 tye' - end. diff --git a/test-suite/bugs/closed/2230.v b/test-suite/bugs/closed/2230.v deleted file mode 100644 index 5076fb2bb7..0000000000 --- a/test-suite/bugs/closed/2230.v +++ /dev/null @@ -1,6 +0,0 @@ -Goal forall f, f 1 1 -> True. -intros. -match goal with - | [ H : _ ?a |- _ ] => idtac -end. -Abort. diff --git a/test-suite/bugs/closed/2231.v b/test-suite/bugs/closed/2231.v deleted file mode 100644 index 03e2c9bbf4..0000000000 --- a/test-suite/bugs/closed/2231.v +++ /dev/null @@ -1,3 +0,0 @@ -Inductive unit2 : Type := U : unit -> unit2. -Inductive dummy (u: unit2) : unit -> Type := - V: dummy u (let (tt) := u in tt). diff --git a/test-suite/bugs/closed/2243.v b/test-suite/bugs/closed/2243.v deleted file mode 100644 index 6d45c9a09e..0000000000 --- a/test-suite/bugs/closed/2243.v +++ /dev/null @@ -1,9 +0,0 @@ -Inductive is_nul: nat -> Prop := X: is_nul 0. -Section O. -Variable u: nat. -Variable H: is_nul u. -Goal True. -Proof. -destruct H. -Undo. -revert H; intro H; destruct H. diff --git a/test-suite/bugs/closed/2244.v b/test-suite/bugs/closed/2244.v deleted file mode 100644 index d499e515fe..0000000000 --- a/test-suite/bugs/closed/2244.v +++ /dev/null @@ -1,19 +0,0 @@ -(* 1st-order unification did not work when in competition with pattern unif. *) - -Set Implicit Arguments. -Lemma test : forall - (A : Type) - (B : Type) - (f : A -> B) - (S : B -> Prop) - (EV : forall y (f':A->B), (forall x', S (f' x')) -> S (f y)) - (HS : forall x', S (f x')) - (x : A), - S (f x). -Proof. - intros. eapply EV. intros. - (* worked in v8.2 but not in v8.3beta, fixed in r12898 *) - apply HS. - - (* still not compatible with 8.2 because an evar can be solved in - two different ways and is left open *) diff --git a/test-suite/bugs/closed/2245.v b/test-suite/bugs/closed/2245.v deleted file mode 100644 index f0162f3b27..0000000000 --- a/test-suite/bugs/closed/2245.v +++ /dev/null @@ -1,11 +0,0 @@ -Module Type Test. - -Section Sec. -Variables (A:Type). -Context (B:Type). -End Sec. - -Fail Check B. (* used to be found !!! *) -Fail Check A. - -End Test. diff --git a/test-suite/bugs/closed/2250.v b/test-suite/bugs/closed/2250.v deleted file mode 100644 index 565d7b68fd..0000000000 --- a/test-suite/bugs/closed/2250.v +++ /dev/null @@ -1,3 +0,0 @@ -Check prod: Prop -> Prop -> Prop. -(* (fun A B : Prop => (A * B)%type):Prop -> Prop -> Prop - : Prop -> Prop -> Prop *) diff --git a/test-suite/bugs/closed/2251.v b/test-suite/bugs/closed/2251.v deleted file mode 100644 index d0fa3f2b33..0000000000 --- a/test-suite/bugs/closed/2251.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Check that rewrite does not apply to single evars *) - -Lemma evar_rewrite : (forall a : nat, a = 0 -> True) -> True. -intros; eapply H. (* goal is ?30 = nil *) -Fail rewrite plus_n_Sm. -Abort. diff --git a/test-suite/bugs/closed/2255.v b/test-suite/bugs/closed/2255.v deleted file mode 100644 index bf80ff6607..0000000000 --- a/test-suite/bugs/closed/2255.v +++ /dev/null @@ -1,21 +0,0 @@ -(* Check injection in presence of dependencies hidden in applicative terms *) - -Inductive TupleT : nat -> Type := - nilT : TupleT 0 -| consT {n} A : (A -> TupleT n) -> TupleT (S n). - -Inductive Tuple : forall n, TupleT n -> Type := - nil : Tuple _ nilT -| cons {n} A (x : A) (F : A -> TupleT n) : Tuple _ (F x) -> Tuple _ (consT A F). - -Goal forall n A F x X n0 A0 x0 F0 H0 (H : existT (fun n0 : nat => {H0 : TupleT -n0 & Tuple n0 H0}) - (S n0) - (existT (fun H0 : TupleT (S n0) => Tuple (S n0) H0) - (consT A0 F0) (cons A0 x0 F0 H0)) = - existT (fun n0 : nat => {H0 : TupleT n0 & Tuple n0 H0}) - (S n) - (existT (fun H0 : TupleT (S n) => Tuple (S n) H0) - (consT A F) (cons A x F X))), False. -intros. -injection H. diff --git a/test-suite/bugs/closed/2262.v b/test-suite/bugs/closed/2262.v deleted file mode 100644 index b61f18b837..0000000000 --- a/test-suite/bugs/closed/2262.v +++ /dev/null @@ -1,11 +0,0 @@ - - -Generalizable Variables A. -Class Test A := { test : A }. - -Lemma mylemma : forall `{Test A}, test = test. -Admitted. (* works fine *) - -Definition mylemma' := forall `{Test A}, test = test. -About mylemma'. - diff --git a/test-suite/bugs/closed/2281.v b/test-suite/bugs/closed/2281.v deleted file mode 100644 index 8f549b9201..0000000000 --- a/test-suite/bugs/closed/2281.v +++ /dev/null @@ -1,50 +0,0 @@ -(** Bug #2281 - -In the code below, coq is confused by an equality unless it is first 'subst'ed -away, yet http://coq.inria.fr/stdlib/Coq.FSets.FSetDecide.html says - - fsetdec will first perform any necessary zeta and beta reductions and will -invoke subst to eliminate any Coq equalities between finite sets or their -elements. - -I have coq r12851. - -*) - -Require Import Arith. -Require Import FSets. -Require Import FSetWeakList. - -Module DecidableNat. -Definition t := nat. -Definition eq := @eq nat. -Definition eq_refl := @refl_equal nat. -Definition eq_sym := @sym_eq nat. -Definition eq_trans := @trans_eq nat. -Definition eq_dec := eq_nat_dec. -End DecidableNat. - -Module NatSet := Make(DecidableNat). - -Module Export NameSetDec := WDecide (NatSet). - -Lemma ThisLemmaWorks : forall ( s1 s2 : NatSet.t ) - ( H : s1 = s2 ), - NatSet.Equal s1 s2. -Proof. -intros. -subst. -fsetdec. -Qed. - -Import FSetDecideAuxiliary. - -Lemma ThisLemmaWasFailing : forall ( s1 s2 : NatSet.t ) - ( H : s1 = s2 ), - NatSet.Equal s1 s2. -Proof. -intros. -fsetdec. -(* Error: Tactic failure: because the goal is beyond the scope of this tactic. -*) -Qed. diff --git a/test-suite/bugs/closed/2295.v b/test-suite/bugs/closed/2295.v deleted file mode 100644 index f5ca28dcaa..0000000000 --- a/test-suite/bugs/closed/2295.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Check if omission of "as" in return clause works w/ section variables too *) - -Section sec. - -Variable b: bool. - -Definition d' := - (match b return b = true \/ b = false with - | true => or_introl _ (refl_equal true) - | false => or_intror _ (refl_equal false) - end). diff --git a/test-suite/bugs/closed/2299.v b/test-suite/bugs/closed/2299.v deleted file mode 100644 index c0552ca7b3..0000000000 --- a/test-suite/bugs/closed/2299.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Check that destruct refreshes universes in what it generalizes *) - -Section test. - -Variable A: Type. - -Inductive T: unit -> Type := C: A -> unit -> T tt. - -Let unused := T tt. - -Goal T tt -> False. - intro X. - destruct X. diff --git a/test-suite/bugs/closed/2300.v b/test-suite/bugs/closed/2300.v deleted file mode 100644 index 4e587cbb25..0000000000 --- a/test-suite/bugs/closed/2300.v +++ /dev/null @@ -1,15 +0,0 @@ -(* Check some behavior of Ltac pattern-matching wrt universe levels *) - -Section contents. - -Variables (A: Type) (B: (unit -> Type) -> Type). - -Inductive C := c: A -> unit -> C. - -Let unused2 (x: unit) := C. - -Goal True. -intuition. -Qed. - -End contents. diff --git a/test-suite/bugs/closed/2303.v b/test-suite/bugs/closed/2303.v deleted file mode 100644 index e614b9b552..0000000000 --- a/test-suite/bugs/closed/2303.v +++ /dev/null @@ -1,4 +0,0 @@ -Class A := a: unit. -Class B (x: unit). -Axiom H: forall x: A, @B x -> x = x -> unit. -Definition Field (z: A) (m: @B z) x := (@H _ _ x) = z. diff --git a/test-suite/bugs/closed/2304.v b/test-suite/bugs/closed/2304.v deleted file mode 100644 index 1ac2702b0a..0000000000 --- a/test-suite/bugs/closed/2304.v +++ /dev/null @@ -1,4 +0,0 @@ -(* This used to fail with an anomaly NotASort at some time *) -Class A (O: Type): Type := a: O -> Type. -Fail Goal forall (x: a tt), @a x = @a x. - diff --git a/test-suite/bugs/closed/2307.v b/test-suite/bugs/closed/2307.v deleted file mode 100644 index 7c04949539..0000000000 --- a/test-suite/bugs/closed/2307.v +++ /dev/null @@ -1,3 +0,0 @@ -Inductive V: nat -> Type := VS n: V (S n). -Definition f (e: V 1): nat := match e with VS 0 => 3 end. - diff --git a/test-suite/bugs/closed/2310.v b/test-suite/bugs/closed/2310.v deleted file mode 100644 index 14a3e5a7b0..0000000000 --- a/test-suite/bugs/closed/2310.v +++ /dev/null @@ -1,21 +0,0 @@ -(* Dependent higher-order hole in "refine" (simplified version) *) - -Set Implicit Arguments. - -Inductive Nest t := Cons : Nest (prod t t) -> Nest t. - -Definition cast A x y Heq P H := @eq_rect A x P H y Heq. - -Definition replace a (y:Nest (prod a a)) : a = a -> Nest a. - -(* This used to raise an anomaly Unknown Meta in 8.2 and 8.3beta. - It raises a regular error in 8.3 and almost succeeds with the new - proof engine: there are two solutions to a unification problem - (P:=\a.Nest (prod a a) and P:=\_.Nest (prod a a)) and refine should either - leave P as subgoal or choose itself one solution *) - - intros. Fail refine (Cons (cast H _ y)). - Unset Solve Unification Constraints. (* Keep the unification constraint around *) - refine (Cons (cast H _ y)). - intros. - refine (Nest (prod X X)). Qed. diff --git a/test-suite/bugs/closed/2319.v b/test-suite/bugs/closed/2319.v deleted file mode 100644 index 73d95e91a1..0000000000 --- a/test-suite/bugs/closed/2319.v +++ /dev/null @@ -1,13 +0,0 @@ -Section S. - - CoInductive A (X: Type) := mkA: A X -> A X. - Variable T : Type. - - (* This used to loop (bug #2319) *) - Timeout 5 Eval vm_compute in cofix s : A T := mkA T s. - - CoFixpoint s : A T := mkA T s - with t : A unit := mkA unit (mkA unit t). - Timeout 5 Eval vm_compute in s. - -End S. diff --git a/test-suite/bugs/closed/2320.v b/test-suite/bugs/closed/2320.v deleted file mode 100644 index facb9ecfc9..0000000000 --- a/test-suite/bugs/closed/2320.v +++ /dev/null @@ -1,14 +0,0 @@ -(* Managing metavariables in the return clause of a match *) - -(* This was working in 8.1 but is failing in 8.2 and 8.3. It works in - trunk thanks to the new proof engine. It could probably made to work in - 8.2 and 8.3 if a return predicate of the form "dummy 0" instead of - (or in addition to) a sophisticated predicate of the form - "as x in dummy y return match y with 0 => ?P | _ => ID end" *) - -Inductive dummy : nat -> Prop := constr : dummy 0. - -Lemma failure : forall (x : dummy 0), x = constr. -Proof. -intros x. -refine (match x with constr => _ end). diff --git a/test-suite/bugs/closed/2342.v b/test-suite/bugs/closed/2342.v deleted file mode 100644 index 6613b28571..0000000000 --- a/test-suite/bugs/closed/2342.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Checking that the type inference algoithme does not commit to an - equality over sorts when only a subtyping constraint is around *) - -Parameter A : Set. -Parameter B : A -> Set. -Parameter F : Set -> Prop. -Check (F (forall x, B x)). - diff --git a/test-suite/bugs/closed/2347.v b/test-suite/bugs/closed/2347.v deleted file mode 100644 index e433f158e4..0000000000 --- a/test-suite/bugs/closed/2347.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import EquivDec List. -Generalizable All Variables. - -Program Definition list_eqdec `(eqa : EqDec A eq) : EqDec (list A) eq := - (fun (x y : list A) => _). -Admit Obligations of list_eqdec. - -Program Definition list_eqdec' `(eqa : EqDec A eq) : EqDec (list A) eq := - (fun _ : nat => (fun (x y : list A) => _)) 0. -Admit Obligations of list_eqdec'. diff --git a/test-suite/bugs/closed/2350.v b/test-suite/bugs/closed/2350.v deleted file mode 100644 index e91f22e267..0000000000 --- a/test-suite/bugs/closed/2350.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Check that the fix tactic, when called from refine, reduces enough - to see the products *) - -Definition foo := forall n:nat, n=n. -Definition bar : foo. -refine (fix aux (n:nat) := _). diff --git a/test-suite/bugs/closed/2353.v b/test-suite/bugs/closed/2353.v deleted file mode 100644 index baae9a6ece..0000000000 --- a/test-suite/bugs/closed/2353.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Are recursively non-uniform params correctly treated? *) -Inductive list (A:nat -> Type) n := cons : A n -> list A (S n) -> list A n. -Inductive term n := app (l : list term n). -Definition term_list := - fix term_size n (t : term n) (acc : nat) {struct t} : nat := - match t with - | app _ l => - (fix term_list_size n (l : list term n) (acc : nat) {struct l} : nat := - match l with - | cons _ _ t q => term_list_size (S n) q (term_size n t acc) - end) n l (S acc) - end. diff --git a/test-suite/bugs/closed/2360.v b/test-suite/bugs/closed/2360.v deleted file mode 100644 index 4ae97c97bb..0000000000 --- a/test-suite/bugs/closed/2360.v +++ /dev/null @@ -1,13 +0,0 @@ -(* This failed in V8.3 because descend_in_conjunctions built ill-typed terms *) -Definition interp (etyp : nat -> Type) (p: nat) := etyp p. - -Record Value (etyp : nat -> Type) := Mk { - typ : nat; - value : interp etyp typ -}. - -Definition some_value (etyp : nat -> Type) : (Value etyp). -Proof. - intros. - Fail apply Mk. (* Check that it does not raise an anomaly *) - diff --git a/test-suite/bugs/closed/2362.v b/test-suite/bugs/closed/2362.v deleted file mode 100644 index 10e86cd12d..0000000000 --- a/test-suite/bugs/closed/2362.v +++ /dev/null @@ -1,38 +0,0 @@ -Set Implicit Arguments. - -Class Pointed (M:Type -> Type) := -{ - creturn: forall {A: Type}, A -> M A -}. - -Unset Implicit Arguments. -Inductive FPair (A B:Type) (neutral: B) : Type:= - fpair : forall (a:A) (b:B), FPair A B neutral. -Arguments fpair {A B neutral}. - -Set Implicit Arguments. - -Notation "( x ,> y )" := (fpair x y) (at level 0). - -Instance Pointed_FPair B neutral: - Pointed (fun A => FPair A B neutral) := - { creturn := fun A (a:A) => (a,> neutral) }. -Definition blah_fail (x:bool) : FPair bool nat O := - creturn x. -Set Printing All. Print blah_fail. - -Definition blah_explicit (x:bool) : FPair bool nat O := - @creturn _ (Pointed_FPair _ ) _ x. - -Print blah_explicit. - - -Instance Pointed_FPair_mono: - Pointed (fun A => FPair A nat 0) := - { creturn := fun A (a:A) => (a,> 0) }. - - -Definition blah (x:bool) : FPair bool nat O := - creturn x. - - diff --git a/test-suite/bugs/closed/2375.v b/test-suite/bugs/closed/2375.v deleted file mode 100644 index c17c426cda..0000000000 --- a/test-suite/bugs/closed/2375.v +++ /dev/null @@ -1,18 +0,0 @@ -(* In the following code, the (superfluous) lemma [lem] is responsible -for the failure of congruence. *) - -Definition f : nat -> Prop := fun x => True. - -Lemma lem : forall x, (True -> True) = ( True -> f x). -Proof. - intros. reflexivity. -Qed. - -Goal forall (x:nat), x = x. -Proof. - intros. - assert (lem := lem). - (*clear ax.*) - congruence. -Qed. - diff --git a/test-suite/bugs/closed/2378.v b/test-suite/bugs/closed/2378.v deleted file mode 100644 index b9dd654057..0000000000 --- a/test-suite/bugs/closed/2378.v +++ /dev/null @@ -1,610 +0,0 @@ -Require Import TestSuite.admit. -(* test with Coq 8.3rc1 *) - -Require Import Program. - -Inductive Unit: Set := unit: Unit. - -Definition eq_dec T := forall x y:T, {x=y}+{x<>y}. - -Section TTS_TASM. - -Variable Time: Set. -Variable Zero: Time. -Variable tle: Time -> Time -> Prop. -Variable tlt: Time -> Time -> Prop. -Variable tadd: Time -> Time -> Time. -Variable tsub: Time -> Time -> Time. -Variable tmin: Time -> Time -> Time. -Notation "t1 @<= t2" := (tle t1 t2) (at level 70, no associativity). -Notation "t1 @< t2" := (tlt t1 t2) (at level 70, no associativity). -Notation "t1 @+ t2" := (tadd t1 t2) (at level 50, left associativity). -Notation "t1 @- t2" := (tsub t1 t2) (at level 50, left associativity). -Notation "t1 @<= t2 @<= t3" := ((tle t1 t2) /\ (tle t2 t3)) (at level 70, t2 at next level). -Notation "t1 @<= t2 @< t3" := ((tle t1 t2) /\ (tlt t2 t3)) (at level 70, t2 at next level). - -Variable tzerop: forall n, (n = Zero) + {Zero @< n}. -Variable tlt_eq_gt_dec: forall x y, {x @< y} + {x=y} + {y @< x}. -Variable tle_plus_l: forall n m, n @<= n @+ m. -Variable tle_lt_eq_dec: forall n m, n @<= m -> {n @< m} + {n = m}. - -Variable tzerop_zero: tzerop Zero = inleft (Zero @< Zero) (@eq_refl _ Zero). -Variable tplus_n_O: forall n, n @+ Zero = n. -Variable tlt_le_weak: forall n m, n @< m -> n @<= m. -Variable tlt_irrefl: forall n, ~ n @< n. -Variable tplus_nlt: forall n m, ~n @+ m @< n. -Variable tle_n: forall n, n @<= n. -Variable tplus_lt_compat_l: forall n m p, n @< m -> p @+ n @< p @+ m. -Variable tlt_trans: forall n m p, n @< m -> m @< p -> n @< p. -Variable tle_lt_trans: forall n m p, n @<= m -> m @< p -> n @< p. -Variable tlt_le_trans: forall n m p, n @< m -> m @<= p -> n @< p. -Variable tle_refl: forall n, n @<= n. -Variable tplus_le_0: forall n m, n @+ m @<= n -> m = Zero. -Variable Time_eq_dec: eq_dec Time. - -(*************************************************************) - -Section PropLogic. -Variable Predicate: Type. - -Inductive LP: Type := - LPPred: Predicate -> LP -| LPAnd: LP -> LP -> LP -| LPNot: LP -> LP. - -Variable State: Type. -Variable Sat: State -> Predicate -> Prop. - -Fixpoint lpSat st f: Prop := - match f with - LPPred p => Sat st p - | LPAnd f1 f2 => lpSat st f1 /\ lpSat st f2 - | LPNot f1 => ~lpSat st f1 - end. -End PropLogic. - -Arguments lpSat : default implicits. - -Fixpoint LPTransfo Pred1 Pred2 p2lp (f: LP Pred1): LP Pred2 := - match f with - LPPred _ p => p2lp p - | LPAnd _ f1 f2 => LPAnd _ (LPTransfo Pred1 Pred2 p2lp f1) (LPTransfo Pred1 Pred2 p2lp f2) - | LPNot _ f1 => LPNot _ (LPTransfo Pred1 Pred2 p2lp f1) - end. -Arguments LPTransfo : default implicits. - -Definition addIndex (Ind:Type) (Pred: Ind -> Type) (i: Ind) f := - LPTransfo (fun p => LPPred _ (existT (fun i => Pred i) i p)) f. - -Section TTS. - -Variable State: Type. - -Record TTS: Type := mkTTS { - Init: State -> Prop; - Delay: State -> Time -> State -> Prop; - Next: State -> State -> Prop; - Predicate: Type; - Satisfy: State -> Predicate -> Prop -}. - -Definition TTSIndexedProduct Ind (tts: Ind -> TTS): TTS := mkTTS - (fun st => forall i, Init (tts i) st) - (fun st d st' => forall i, Delay (tts i) st d st') - (fun st st' => forall i, Next (tts i) st st') - { i: Ind & Predicate (tts i) } - (fun st p => Satisfy (tts (projT1 p)) st (projT2 p)). - -End TTS. - -Section SIMU_F. - -Variables StateA StateC: Type. - -Record mapping: Type := mkMapping { - mState: Type; - mInit: StateC -> mState; - mNext: mState -> StateC -> mState; - mDelay: mState -> StateC -> Time -> mState; - mabs: mState -> StateC -> StateA -}. - -Variable m: mapping. - -Record simu (Pred: Type) (a: TTS StateA) (c: TTS StateC) (tra: Pred -> LP (Predicate _ a)) (trc: Pred -> LP (Predicate _ c)): Type := simuPrf { - inv: (mState m) -> StateC -> Prop; - invInit: forall st, Init _ c st -> inv (mInit m st) st; - invDelay: forall ex1 st1 st2 d, Delay _ c st1 d st2 -> inv ex1 st1 -> inv (mDelay m ex1 st1 d) st2; - invNext: forall ex1 st1 st2, Next _ c st1 st2 -> inv ex1 st1 -> inv (mNext m ex1 st1) st2; - simuInit: forall st, Init _ c st -> Init _ a (mabs m (mInit m st) st); - simuDelay: forall ex1 st1 st2 d, Delay _ c st1 d st2 -> inv ex1 st1 -> - Delay _ a (mabs m ex1 st1) d (mabs m (mDelay m ex1 st1 d) st2); - simuNext: forall ex1 st1 st2, Next _ c st1 st2 -> inv ex1 st1 -> - Next _ a (mabs m ex1 st1) (mabs m (mNext m ex1 st1) st2); - simuPred: forall ext st, inv ext st -> - (forall p, lpSat (Satisfy _ c) st (trc p) <-> lpSat (Satisfy _ a) (mabs m ext st) (tra p)) -}. - -Theorem satProd: forall State Ind Pred (Sat: forall i, State -> Pred i -> Prop) (st:State) i (f: LP (Pred i)), - lpSat (Sat i) st f - <-> - lpSat - (fun (st : State) (p : {i : Ind & Pred i}) => Sat (projT1 p) st (projT2 p)) st - (addIndex Ind _ i f). -Proof. - induction f; simpl; intros; split; intros; intuition. -Qed. - -Definition trProd (State: Type) Ind (Pred: Ind -> Type) (tts: Ind -> TTS State) (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))): - {i:Ind & Pred i} -> LP (Predicate _ (TTSIndexedProduct _ Ind tts)) := - fun p => addIndex Ind _ (projT1 p) (tr (projT1 p) (projT2 p)). - -Arguments trProd : default implicits. -Require Import Setoid. - -Theorem satTrProd: - forall State Ind Pred (tts: Ind -> TTS State) - (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))) (st:State) (p: {i:Ind & (Pred i)}), - lpSat (Satisfy _ (tts (projT1 p))) st (tr (projT1 p) (projT2 p)) - <-> - lpSat (Satisfy _ (TTSIndexedProduct _ _ tts)) st (trProd _ tts tr p). -Proof. - unfold trProd, TTSIndexedProduct; simpl; intros. - rewrite (satProd State Ind (fun i => Predicate State (tts i)) - (fun i => Satisfy _ (tts i))); tauto. -Qed. - -Theorem simuProd: - forall Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) - (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) - (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), - (forall i, simu _ (tta i) (ttc i) (tra i) (trc i)) -> - simu _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) - (trProd Pred tta tra) (trProd Pred ttc trc). -Proof. - intros. - apply simuPrf with (fun ex st => forall i, inv _ _ (ttc i) (tra i) (trc i) (X i) ex st); simpl; intros; auto. - eapply invInit; eauto. - eapply invDelay; eauto. - eapply invNext; eauto. - eapply simuInit; eauto. - eapply simuDelay; eauto. - eapply simuNext; eauto. - split; simpl; intros. - generalize (proj1 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. - rewrite <- (satTrProd StateA Ind Pred tta tra); apply H1. - rewrite (satTrProd StateC Ind Pred ttc trc); apply H0. - - generalize (proj2 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. - rewrite <- (satTrProd StateC Ind Pred ttc trc); apply H1. - rewrite (satTrProd StateA Ind Pred tta tra); apply H0. -Qed. - -End SIMU_F. - -Section TRANSFO. - -Record simu_equiv StateA StateC m1 m2 Pred (a: TTS StateA) (c: TTS StateC) (tra: Pred -> LP (Predicate _ a)) (trc: Pred -> LP (Predicate _ c)): Type := simuEquivPrf { - simuLR: simu StateA StateC m1 Pred a c tra trc; - simuRL: simu StateC StateA m2 Pred c a trc tra -}. - -Theorem simu_equivProd: - forall StateA StateC m1 m2 Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) - (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) - (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), - (forall i, simu_equiv StateA StateC m1 m2 _ (tta i) (ttc i) (tra i) (trc i)) -> - simu_equiv StateA StateC m1 m2 _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) - (trProd _ _ Pred tta tra) (trProd _ _ Pred ttc trc). -Proof. - intros; split; intros. - apply simuProd; intro. - elim (X i); auto. - apply simuProd; intro. - elim (X i); auto. -Qed. - -Record RTLanguage: Type := mkRTLanguage { - Syntax: Type; - DynamicState: Syntax -> Type; - Semantic: forall (mdl:Syntax), TTS (DynamicState mdl); - MdlPredicate: Syntax -> Type; - MdlPredicateDefinition: forall mdl, MdlPredicate mdl -> LP (Predicate _ (Semantic mdl)) -}. - -Record Transformation (l1 l2: RTLanguage): Type := mkTransformation { - Tmodel: Syntax l1 -> Syntax l2; - Tl1l2: forall mdl, mapping (DynamicState l1 mdl) (DynamicState l2 (Tmodel mdl)); - Tl2l1: forall mdl, mapping (DynamicState l2 (Tmodel mdl)) (DynamicState l1 mdl); - Tpred: forall mdl, MdlPredicate l1 mdl -> LP (MdlPredicate l2 (Tmodel mdl)); - Tsim: forall mdl, simu_equiv (DynamicState l1 mdl) (DynamicState l2 (Tmodel mdl)) (Tl1l2 mdl) (Tl2l1 mdl) - (MdlPredicate l1 mdl) (Semantic l1 mdl) (Semantic l2 (Tmodel mdl)) - (MdlPredicateDefinition l1 mdl) - (fun p => LPTransfo (MdlPredicateDefinition l2 (Tmodel mdl)) (Tpred mdl p)) -}. - -Section Product. - -Record PSyntax (L: RTLanguage): Type := mkPSyntax { - pIndex: Type; - pIsEmpty: pIndex + {pIndex -> False}; - pState: Type; - pComponents: pIndex -> Syntax L; - pIsShared: forall i, DynamicState L (pComponents i) = pState -}. - -Definition pPredicate (L: RTLanguage) (sys: PSyntax L) := { i : pIndex L sys & MdlPredicate L (pComponents L sys i)}. - -(* product with shared state *) - -Definition PLanguage (L: RTLanguage): RTLanguage := - mkRTLanguage - (PSyntax L) - (pState L) - (fun mdl => TTSIndexedProduct (pState L mdl) (pIndex L mdl) - (fun i => match pIsShared L mdl i in (_ = y) return TTS y with - eq_refl => Semantic L (pComponents L mdl i) - end)) - (pPredicate L) - (fun mdl => trProd _ _ _ _ - (fun i pi => match pIsShared L mdl i as e in (_ = y) return - (LP (Predicate y - match e in (_ = y0) return (TTS y0) with - | eq_refl => Semantic L (pComponents L mdl i) - end)) - with - | eq_refl => MdlPredicateDefinition L (pComponents L mdl i) pi - end)). - -Inductive Empty: Type :=. - -Record isSharedTransfo l1 l2 tr: Prop := isSharedTransfoPrf { -sameState: forall mdl i j, - DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) = - DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j)); -sameMState: forall mdl i j, - mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl i)) = - mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl j)); -sameM12: forall mdl i j, - Tl1l2 _ _ tr (pComponents l1 mdl i) = - match sym_eq (sameState mdl i j) in _=y return mapping _ y with - eq_refl => match sym_eq (pIsShared l1 mdl i) in _=x return mapping x _ with - eq_refl => match pIsShared l1 mdl j in _=x return mapping x _ with - eq_refl => Tl1l2 _ _ tr (pComponents l1 mdl j) - end - end - end; -sameM21: forall mdl i j, - Tl2l1 l1 l2 tr (pComponents l1 mdl i) = - match - sym_eq (sameState mdl i j) in (_ = y) - return (mapping y (DynamicState l1 (pComponents l1 mdl i))) - with eq_refl => - match - sym_eq (pIsShared l1 mdl i) in (_ = y) - return - (mapping (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j))) y) - with - | eq_refl => - match - pIsShared l1 mdl j in (_ = y) - return - (mapping - (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j))) y) - with - | eq_refl => Tl2l1 l1 l2 tr (pComponents l1 mdl j) - end - end -end -}. - -Definition PTransfoSyntax l1 l2 tr (h: isSharedTransfo l1 l2 tr) mdl := - mkPSyntax l2 (pIndex l1 mdl) - (pIsEmpty l1 mdl) - (match pIsEmpty l1 mdl return Type with - inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) - |inright h => pState l1 mdl - end) - (fun i => Tmodel l1 l2 tr (pComponents l1 mdl i)) - (fun i => match pIsEmpty l1 mdl as y return - (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) = - match y with - | inleft i0 => - DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i0)) - | inright _ => pState l1 mdl - end) - with - inleft j => sameState l1 l2 tr h mdl i j - | inright h => match h i with end - end). - -Definition compSemantic l mdl i := - match pIsShared l mdl i in (_=y) return TTS y with - eq_refl => Semantic l (pComponents l mdl i) - end. - -Definition compSemanticEq l mdl i s (e: DynamicState l (pComponents l mdl i) = s) := - match e in (_=y) return TTS y with - eq_refl => Semantic l (pComponents l mdl i) - end. - -Definition Pmap12 l1 l2 tr (h: isSharedTransfo l1 l2 tr) (mdl : PSyntax l1) := -match - pIsEmpty l1 mdl as s - return - (mapping (pState l1 mdl) - match s with - | inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) - | inright _ => pState l1 mdl - end) -with -| inleft p => - match - pIsShared l1 mdl p in (_ = y) - return - (mapping y (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p)))) - with - | eq_refl => Tl1l2 l1 l2 tr (pComponents l1 mdl p) - end -| inright _ => - mkMapping (pState l1 mdl) (pState l1 mdl) Unit - (fun _ : pState l1 mdl => unit) - (fun (_ : Unit) (_ : pState l1 mdl) => unit) - (fun (_ : Unit) (_ : pState l1 mdl) (_ : Time) => unit) - (fun (_ : Unit) (X : pState l1 mdl) => X) -end. - -Definition Pmap21 l1 l2 tr (h : isSharedTransfo l1 l2 tr) mdl := -match - pIsEmpty l1 mdl as s - return - (mapping - match s with - | inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) - | inright _ => pState l1 mdl - end (pState l1 mdl)) -with -| inleft p => - match - pIsShared l1 mdl p in (_ = y) - return - (mapping (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p))) y) - with - | eq_refl => Tl2l1 l1 l2 tr (pComponents l1 mdl p) - end -| inright _ => - mkMapping (pState l1 mdl) (pState l1 mdl) Unit - (fun _ : pState l1 mdl => unit) - (fun (_ : Unit) (_ : pState l1 mdl) => unit) - (fun (_ : Unit) (_ : pState l1 mdl) (_ : Time) => unit) - (fun (_ : Unit) (X : pState l1 mdl) => X) -end. - -Definition PTpred l1 l2 tr (h : isSharedTransfo l1 l2 tr) mdl (pp : pPredicate l1 mdl): - LP (MdlPredicate (PLanguage l2) (PTransfoSyntax l1 l2 tr h mdl)) := -match pIsEmpty l1 mdl with -| inleft _ => - let (x, p) := pp in - addIndex (pIndex l1 mdl) (fun i => MdlPredicate l2 (Tmodel l1 l2 tr (pComponents l1 mdl i))) x - (LPTransfo (Tpred l1 l2 tr (pComponents l1 mdl x)) - (LPPred (MdlPredicate l1 (pComponents l1 mdl x)) p)) -| inright f => match f (projT1 pp) with end -end. - -Lemma simu_eqA: - forall A1 A2 C m P sa sc tta ttc (h: A2=A1), - simu A1 C (match h in (_=y) return mapping _ C with eq_refl => m end) - P (match h in (_=y) return TTS y with eq_refl => sa end) - sc (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => tta p end) - ttc -> - simu A2 C m P sa sc tta ttc. -admit. -Qed. - -Lemma simu_eqC: - forall A C1 C2 m P sa sc tta ttc (h: C2=C1), - simu A C1 (match h in (_=y) return mapping A _ with eq_refl => m end) - P sa (match h in (_=y) return TTS y with eq_refl => sc end) - tta (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => ttc p end) - -> - simu A C2 m P sa sc tta ttc. -admit. -Qed. - -Lemma simu_eqA1: - forall A1 A2 C m P sa sc tta ttc (h: A1=A2), - simu A1 C m - P - (match (sym_eq h) in (_=y) return TTS y with eq_refl => sa end) sc - (fun p => match (sym_eq h) as e in (_=y) return LP (Predicate y (match e in (_=z) return TTS z with eq_refl => sa end)) with eq_refl => tta p end) ttc - -> - simu A2 C (match h in (_=y) return mapping _ C with eq_refl => m end) P sa sc tta ttc. -admit. -Qed. - -Lemma simu_eqA2: - forall A1 A2 C m P sa sc tta ttc (h: A1=A2), - simu A1 C (match (sym_eq h) in (_=y) return mapping _ C with eq_refl => m end) - P - sa sc tta ttc - -> - simu A2 C m P - (match h in (_=y) return TTS y with eq_refl => sa end) sc - (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sa end) with eq_refl => tta p end) - ttc. -admit. -Qed. - -Lemma simu_eqC2: - forall A C1 C2 m P sa sc tta ttc (h: C1=C2), - simu A C1 (match (sym_eq h) in (_=y) return mapping A _ with eq_refl => m end) - P - sa sc tta ttc - -> - simu A C2 m P - sa (match h in (_=y) return TTS y with eq_refl => sc end) - tta (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sc end) with eq_refl => ttc p end). -admit. -Qed. - -Lemma simu_eqM: - forall A C m1 m2 P sa sc tta ttc (h: m1=m2), - simu A C m1 P sa sc tta ttc - -> - simu A C m2 P sa sc tta ttc. -admit. -Qed. - -Lemma LPTransfo_trans: - forall Pred1 Pred2 Pred3 (tr1: Pred1 -> LP Pred2) (tr2: Pred2 -> LP Pred3) f, - LPTransfo tr2 (LPTransfo tr1 f) = LPTransfo (fun x => LPTransfo tr2 (tr1 x)) f. -Proof. - admit. -Qed. - -Lemma LPTransfo_addIndex: - forall Ind Pred tr1 x (tr2: forall i, Pred i -> LP (tr1 i)) (p: LP (Pred x)), - addIndex Ind tr1 x (LPTransfo (tr2 x) p) = - LPTransfo - (fun p0 : {i : Ind & Pred i} => - addIndex Ind tr1 (projT1 p0) (tr2 (projT1 p0) (projT2 p0))) - (addIndex Ind Pred x p). -Proof. - unfold addIndex; intros. - rewrite LPTransfo_trans. - rewrite LPTransfo_trans. - simpl. - auto. -Qed. - -Record tr_compat I0 I1 tr := compatPrf { - and_compat: forall p1 p2, tr (LPAnd I0 p1 p2) = LPAnd I1 (tr p1) (tr p2); - not_compat: forall p, tr (LPNot I0 p) = LPNot I1 (tr p) -}. - -Lemma LPTransfo_addIndex_tr: - forall Ind Pred tr0 tr1 x (tr2: forall i, Pred i -> LP (tr0 i)) (tr3: forall i, LP (tr0 i) -> LP (tr1 i)) (p: LP (Pred x)), - (forall x, tr_compat (tr0 x) (tr1 x) (tr3 x)) -> - addIndex Ind tr1 x (tr3 x (LPTransfo (tr2 x) p)) = - LPTransfo - (fun p0 : {i : Ind & Pred i} => - addIndex Ind tr1 (projT1 p0) (tr3 (projT1 p0) (tr2 (projT1 p0) (projT2 p0)))) - (addIndex Ind Pred x p). -Proof. - unfold addIndex; simpl; intros. - rewrite LPTransfo_trans; simpl. - rewrite <- LPTransfo_trans. - f_equal. - induction p; simpl; intros; auto. - rewrite (and_compat _ _ _ (H x)). - rewrite <- IHp1, <- IHp2; auto. - rewrite <- IHp. - rewrite (not_compat _ _ _ (H x)); auto. -Qed. - -Require Export Coq.Logic.FunctionalExtensionality. -Print PLanguage. - -Program Definition PTransfo l1 l2 (tr: Transformation l1 l2) (h: isSharedTransfo l1 l2 tr): -Transformation (PLanguage l1) (PLanguage l2) := - mkTransformation (PLanguage l1) (PLanguage l2) - (PTransfoSyntax l1 l2 tr h) - (Pmap12 l1 l2 tr h) - (Pmap21 l1 l2 tr h) - (PTpred l1 l2 tr h) - (fun mdl => simu_equivProd - (pState l1 mdl) - (pState l2 (PTransfoSyntax l1 l2 tr h mdl)) - (Pmap12 l1 l2 tr h mdl) - (Pmap21 l1 l2 tr h mdl) - (pIndex l1 mdl) - (fun i => MdlPredicate l1 (pComponents l1 mdl i)) - (compSemantic l1 mdl) - (compSemantic l2 (PTransfoSyntax l1 l2 tr h mdl)) - _ - _ - _ - ). - -Next Obligation. - unfold compSemantic, PTransfoSyntax; simpl. - case (pIsEmpty l1 mdl); simpl; intros. - unfold pPredicate; simpl. - unfold pPredicate in X; simpl in X. - case (sameState l1 l2 tr h mdl i p). - apply (LPTransfo (MdlPredicateDefinition l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)))). - apply (LPTransfo (Tpred l1 l2 tr (pComponents l1 mdl i))). - apply (LPPred _ X). - - apply False_rect; apply (f i). -Defined. - -Next Obligation. - split; intros. - unfold Pmap12; simpl. - unfold PTransfo_obligation_1; simpl. - unfold compSemantic; simpl. - unfold eq_ind, eq_rect, f_equal; simpl. - case (pIsEmpty l1 mdl); intros. - apply simu_eqA2. - apply simu_eqC2. - apply simu_eqM with (Tl1l2 l1 l2 tr (pComponents l1 mdl i)). - apply sameM12. - apply (simuLR _ _ _ _ _ _ _ _ _ (Tsim l1 l2 tr (pComponents l1 mdl i))); intro. - - apply False_rect; apply (f i). - - unfold Pmap21; simpl. - unfold PTransfo_obligation_1; simpl. - unfold compSemantic; simpl. - unfold eq_ind, eq_rect, f_equal; simpl. - case (pIsEmpty l1 mdl); intros. - apply simu_eqC2. - apply simu_eqA2. - apply simu_eqM with (Tl2l1 l1 l2 tr (pComponents l1 mdl i)). - apply sameM21. - apply (simuRL _ _ _ _ _ _ _ _ _ (Tsim l1 l2 tr (pComponents l1 mdl i))); intro. - - apply False_rect; apply (f i). -Qed. - -Next Obligation. - unfold trProd; simpl. - unfold PTransfo_obligation_1; simpl. - unfold compSemantic; simpl. - unfold eq_ind, eq_rect, f_equal; simpl. - apply functional_extensionality; intro. - case x; clear x; intros. - unfold PTpred; simpl. - case (pIsEmpty l1 mdl); simpl; intros. - set (tr0 i := - Predicate (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i))) - (Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)))). - set (tr1 i := - Predicate (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p))) - match sameState l1 l2 tr h mdl i p in (_ = y) return (TTS y) with - | eq_refl => Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) - end). - set (tr2 x := MdlPredicateDefinition l2 (Tmodel l1 l2 tr (pComponents l1 mdl x))). - set (Pred x := MdlPredicate l2 (Tmodel l1 l2 tr (pComponents l1 mdl x))). - set (tr3 x f := match - sameState l1 l2 tr h mdl x p as e in (_ = y) - return - (LP - (Predicate y - match e in (_ = y0) return (TTS y0) with - | eq_refl => Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl x)) - end)) - with - | eq_refl => f - end). - apply (LPTransfo_addIndex_tr _ Pred tr0 tr1 x tr2 tr3 - (Tpred l1 l2 tr (pComponents l1 mdl x) m)). - unfold tr0, tr1, tr3; intros; split; simpl; intros; auto. - case (sameState l1 l2 tr h mdl x0 p); auto. - case (sameState l1 l2 tr h mdl x0 p); auto. - - apply False_rect; apply (f x). -Qed. - -End Product. diff --git a/test-suite/bugs/closed/2388.v b/test-suite/bugs/closed/2388.v deleted file mode 100644 index c792671193..0000000000 --- a/test-suite/bugs/closed/2388.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Error message was not printed in the correct environment *) - -Fail Parameters (A:Prop) (a:A A). - -(* This is a variant (reported as part of bug #2347) *) - -Require Import EquivDec. -Fail Program Instance bool_eq_eqdec : EqDec bool eq := - {equiv_dec x y := (fix aux (x y : bool) {struct x}:= aux _ y) x y}. - diff --git a/test-suite/bugs/closed/2393.v b/test-suite/bugs/closed/2393.v deleted file mode 100644 index fb4f92619f..0000000000 --- a/test-suite/bugs/closed/2393.v +++ /dev/null @@ -1,13 +0,0 @@ -Require Import Program. - -Inductive T := MkT. - -Definition sizeOf (t : T) : nat - := match t with - | MkT => 1 - end. -Variable vect : nat -> Type. -Program Fixpoint idType (t : T) (n := sizeOf t) (b : vect n) {measure n} : T - := match t with - | MkT => MkT - end. diff --git a/test-suite/bugs/closed/2404.v b/test-suite/bugs/closed/2404.v deleted file mode 100644 index f6ec676014..0000000000 --- a/test-suite/bugs/closed/2404.v +++ /dev/null @@ -1,46 +0,0 @@ -(* Check that dependencies in the indices of the type of the terms to - match are taken into account and correctly generalized *) - -Require Import Relations.Relation_Definitions. -Require Import Basics. - -Record Base := mkBase - {(* Primitives *) - World : Set - (* Names are real, links are theoretical *) - ; Name : World -> Set - - ; wweak : World -> World -> Prop - - ; exportw : forall a b : World, (wweak a b) -> (Name b) -> option (Name a) -}. - -Section Derived. - Variable base : Base. - Definition bWorld := World base. - Definition bName := Name base. - Definition bexportw := exportw base. - Definition bwweak := wweak base. - - Arguments bexportw [a b]. - -Inductive RstarSetProof {I : Type} (T : I -> I -> Type) : I -> I -> Type := - starReflS : forall a, RstarSetProof T a a -| starTransS : forall i j k, T i j -> (RstarSetProof T j k) -> RstarSetProof T i k. - -Arguments starTransS [I T i j k]. - -Definition RstarInv {A : Set} (rel : relation A) : A -> A -> Type := (flip (RstarSetProof (flip rel))). - -Definition bwweakFlip (b a : bWorld) : Prop := (bwweak a b). -Definition Rweak : forall a b : bWorld, Type := RstarInv bwweak. - -Fixpoint exportRweak {a b} (aRWb : Rweak a b) (y : bName b) : option (bName a) := - match aRWb,y with - | starReflS _ a, y' => Some y' - | starTransS jWk jRWi, y' => - match (bexportw jWk y) with - | Some x => exportRweak jRWi x - | None => None - end - end. diff --git a/test-suite/bugs/closed/2406.v b/test-suite/bugs/closed/2406.v deleted file mode 100644 index 3766e795a0..0000000000 --- a/test-suite/bugs/closed/2406.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Check correct handling of unsupported notations *) -Notation "'’'" := (fun x => x) (at level 20). - -(* This fails with a syntax error but it is not caught by Fail -Fail Definition crash_the_rooster f := ’. -*) diff --git a/test-suite/bugs/closed/2417.v b/test-suite/bugs/closed/2417.v deleted file mode 100644 index b2f00ffc65..0000000000 --- a/test-suite/bugs/closed/2417.v +++ /dev/null @@ -1,15 +0,0 @@ -Parameter x y : nat. -Axiom H : x = y. -Hint Rewrite H : mybase. - -Ltac bar base := autorewrite with base. - -Tactic Notation "foo" ident(base) := autorewrite with base. - -Goal x = 0. - bar mybase. - now_show (y = 0). - Undo 2. - foo mybase. - now_show (y = 0). -Abort. diff --git a/test-suite/bugs/closed/2428.v b/test-suite/bugs/closed/2428.v deleted file mode 100644 index b398a76d91..0000000000 --- a/test-suite/bugs/closed/2428.v +++ /dev/null @@ -1,10 +0,0 @@ -Axiom P : nat -> Prop. - -Definition myFact := forall x, P x. - -Hint Extern 1 (P _) => progress (unfold myFact in *). - -Lemma test : (True -> myFact) -> P 3. -Proof. - intros. debug eauto. -Qed. diff --git a/test-suite/bugs/closed/2447.v b/test-suite/bugs/closed/2447.v deleted file mode 100644 index fdeb69fcc7..0000000000 --- a/test-suite/bugs/closed/2447.v +++ /dev/null @@ -1,7 +0,0 @@ -Record t := {x : bool; y : bool; z : bool}. - -Goal forall x1 x2 y z, - {| x := x1; y := y; z := z |} = {| x := x2; y := y; z := z |} -> x1 = x2. -Proof. -intros; congruence. (* was doing stack overflow *) -Qed. diff --git a/test-suite/bugs/closed/2456.v b/test-suite/bugs/closed/2456.v deleted file mode 100644 index e5a392c4d3..0000000000 --- a/test-suite/bugs/closed/2456.v +++ /dev/null @@ -1,58 +0,0 @@ - -Require Import Equality. - -Parameter Patch : nat -> nat -> Set. - -Inductive Catch (from to : nat) : Type - := MkCatch : forall (p : Patch from to), - Catch from to. -Arguments MkCatch [from to]. - -Inductive CatchCommute5 - : forall {from mid1 mid2 to : nat}, - Catch from mid1 - -> Catch mid1 to - -> Catch from mid2 - -> Catch mid2 to - -> Prop - := MkCatchCommute5 : - forall {from mid1 mid2 to : nat} - (p : Patch from mid1) - (q : Patch mid1 to) - (q' : Patch from mid2) - (p' : Patch mid2 to), - CatchCommute5 (MkCatch p) (MkCatch q) (MkCatch q') (MkCatch p'). - -Inductive CatchCommute {from mid1 mid2 to : nat} - (p : Catch from mid1) - (q : Catch mid1 to) - (q' : Catch from mid2) - (p' : Catch mid2 to) - : Prop - := isCatchCommute5 : forall (catchCommuteDetails : CatchCommute5 p q q' p'), - CatchCommute p q q' p'. -Notation "<< p , q >> <~> << q' , p' >>" - := (CatchCommute p q q' p') - (at level 60, no associativity). - -Lemma CatchCommuteUnique2 : - forall {from mid mid' to : nat} - {p : Catch from mid} {q : Catch mid to} - {q' : Catch from mid'} {p' : Catch mid' to} - {q'' : Catch from mid'} {p'' : Catch mid' to} - (commute1 : <> <~> <>) - (commute2 : <> <~> <>), - (p' = p'') /\ (q' = q''). -Proof with auto. -intros. -set (X := commute2). -Fail dependent destruction commute1; -dependent destruction catchCommuteDetails; -dependent destruction commute2; -dependent destruction catchCommuteDetails generalizing X. -revert X. -dependent destruction commute1; -dependent destruction catchCommuteDetails; -dependent destruction commute2; -dependent destruction catchCommuteDetails. -Abort. diff --git a/test-suite/bugs/closed/2464.v b/test-suite/bugs/closed/2464.v deleted file mode 100644 index b9db30359c..0000000000 --- a/test-suite/bugs/closed/2464.v +++ /dev/null @@ -1,39 +0,0 @@ -Require Import FSetWeakList. -Require Import FSetDecide. - -Parameter Name : Set. -Axiom eq_Name_dec : forall (n : Name) (o : Name), {n = o} + {n <> o}. - -Module DecidableName. -Definition t := Name. -Definition eq := @eq Name. -Definition eq_refl := @refl_equal Name. -Definition eq_sym := @sym_eq Name. -Definition eq_trans := @trans_eq Name. -Definition eq_dec := eq_Name_dec. -End DecidableName. - -Module NameSetMod := Make(DecidableName). - -Module NameSetDec := WDecide (NameSetMod). - -Class PartPatchUniverse (pu_type1 pu_type2 : Type) - : Type := mkPartPatchUniverse { -}. -Class PatchUniverse {pu_type : Type} - (ppu : PartPatchUniverse pu_type pu_type) - : Type := mkPatchUniverse { - pu_nameOf : pu_type -> Name -}. - -Lemma foo : forall (pu_type : Type) - (ppu : PartPatchUniverse pu_type pu_type) - (patchUniverse : PatchUniverse ppu) - (ns ns1 ns2 : NameSetMod.t) - (containsOK : NameSetMod.Equal ns1 ns2) - (p : pu_type) - (HX1 : NameSetMod.Equal ns1 (NameSetMod.add (pu_nameOf p) ns)), - NameSetMod.Equal ns2 (NameSetMod.add (pu_nameOf p) ns). -Proof. -NameSetDec.fsetdec. -Qed. diff --git a/test-suite/bugs/closed/2467.v b/test-suite/bugs/closed/2467.v deleted file mode 100644 index ad17814a8f..0000000000 --- a/test-suite/bugs/closed/2467.v +++ /dev/null @@ -1,49 +0,0 @@ -(* -In the code below, I would expect the - NameSetDec.fsetdec. -to solve the Lemma, but I need to do it in steps instead. - -This is a regression relative to FSet, - -I have v8.3 (13702). -*) - -Require Import Coq.MSets.MSets. - -Parameter Name : Set. -Parameter Name_compare : Name -> Name -> comparison. -Parameter Name_compare_sym : forall {x y : Name}, - Name_compare y x = CompOpp (Name_compare x y). -Parameter Name_compare_trans : forall {c : comparison} - {x y z : Name}, - Name_compare x y = c - -> Name_compare y z = c - -> Name_compare x z = c. -Parameter Name_eq_leibniz : forall {s s' : Name}, - Name_compare s s' = Eq - -> s = s'. - -Module NameOrderedTypeAlt. -Definition t := Name. -Definition compare := Name_compare. -Definition compare_sym := @Name_compare_sym. -Definition compare_trans := @Name_compare_trans. -End NameOrderedTypeAlt. - -Module NameOrderedType := OT_from_Alt(NameOrderedTypeAlt). - -Module NameOrderedTypeWithLeibniz. -Include NameOrderedType. -Definition eq_leibniz := @Name_eq_leibniz. -End NameOrderedTypeWithLeibniz. - -Module NameSetMod := MSetList.MakeWithLeibniz(NameOrderedTypeWithLeibniz). -Module NameSetDec := WDecide (NameSetMod). - -Lemma foo : forall (xs ys : NameSetMod.t) - (n : Name) - (H1 : NameSetMod.Equal xs (NameSetMod.add n ys)), - NameSetMod.In n xs. -Proof. -NameSetDec.fsetdec. -Qed. diff --git a/test-suite/bugs/closed/2473.v b/test-suite/bugs/closed/2473.v deleted file mode 100644 index 0e7c0c25fa..0000000000 --- a/test-suite/bugs/closed/2473.v +++ /dev/null @@ -1,40 +0,0 @@ -Require Import TestSuite.admit. - -Require Import Relations Program Setoid Morphisms. - -Section S1. - Variable R: nat -> relation bool. - Instance HR1: forall n, Transitive (R n). Admitted. - Instance HR2: forall n, Symmetric (R n). Admitted. - Hypothesis H: forall n a, R n (andb a a) a. - Goal forall n a b, R n b a. - intros. - (* rewrite <- H. *) (* Anomaly: Evar ?.. was not declared. Please report. *) - (* idem with setoid_rewrite *) -(* assert (HR2' := HR2 n). *) - rewrite <- H. (* ok *) - admit. - Qed. -End S1. - -Section S2. - Variable R: nat -> relation bool. - Instance HR: forall n, Equivalence (R n). Admitted. - Hypothesis H: forall n a, R n (andb a a) a. - Goal forall n a b, R n a b. - intros. rewrite <- H. admit. - Qed. -End S2. - -(* the parametrised relation is required to get the problem *) -Section S3. - Variable R: relation bool. - Instance HR1': Transitive R. Admitted. - Instance HR2': Symmetric R. Admitted. - Hypothesis H: forall a, R (andb a a) a. - Goal forall a b, R b a. - intros. - rewrite <- H. (* ok *) - admit. - Qed. -End S3. diff --git a/test-suite/bugs/closed/2584.v b/test-suite/bugs/closed/2584.v deleted file mode 100644 index b5a723b47f..0000000000 --- a/test-suite/bugs/closed/2584.v +++ /dev/null @@ -1,89 +0,0 @@ -Require Import List. - -Set Implicit Arguments. - -Definition err : Type := unit. - -Inductive res (A: Type) : Type := -| OK: A -> res A -| Error: err -> res A. - -Arguments Error [A]. - -Set Printing Universes. - -Section FOO. - -Inductive ftyp : Type := - | Funit : ftyp - | Ffun : list ftyp -> ftyp - | Fref : area -> ftyp -with area : Type := - | Stored : ftyp -> area -. - -Print ftyp. -(* yields: -Inductive ftyp : Type (* Top.27429 *) := - Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp - with area : Type (* Set *) := Stored : ftyp -> area -*) - -Fixpoint tc_wf_type (ftype: ftyp) {struct ftype}: res unit := - match ftype with - | Funit => OK tt - | Ffun args => - ((fix tc_wf_types (ftypes: list ftyp){struct ftypes}: res unit := - match ftypes with - | nil => OK tt - | t::ts => - match tc_wf_type t with - | OK tt => tc_wf_types ts - | Error m => Error m - end - end) args) - | Fref a => tc_wf_area a - end -with tc_wf_area (ar:area): res unit := - match ar with - | Stored c => tc_wf_type c - end. - -End FOO. - -Print ftyp. -(* yields: -Inductive ftyp : Type (* Top.27465 *) := - Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp - with area : Set := Stored : ftyp -> area -*) - -Fixpoint tc_wf_type' (ftype: ftyp) {struct ftype}: res unit := - match ftype with - | Funit => OK tt - | Ffun args => - ((fix tc_wf_types (ftypes: list ftyp){struct ftypes}: res unit := - match ftypes with - | nil => OK tt - | t::ts => - match tc_wf_type' t with - | OK tt => tc_wf_types ts - | Error m => Error m - end - end) args) - | Fref a => tc_wf_area' a - end -with tc_wf_area' (ar:area): res unit := - match ar with - | Stored c => tc_wf_type' c - end. - -(* yields: -Error: -Incorrect elimination of "ar" in the inductive type "area": -the return type has sort "Type (* max(Set, Top.27424) *)" while it -should be "Prop" or "Set". -Elimination of an inductive object of sort Set -is not allowed on a predicate in sort Type -because strong elimination on non-small inductive types leads to paradoxes. -*) diff --git a/test-suite/bugs/closed/2586.v b/test-suite/bugs/closed/2586.v deleted file mode 100644 index e57bcc25bb..0000000000 --- a/test-suite/bugs/closed/2586.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import Setoid SetoidClass Program. - -Goal forall `(Setoid nat) x y, x == y -> S x == S y. - intros. - Fail clsubst H0. - Abort. diff --git a/test-suite/bugs/closed/2590.v b/test-suite/bugs/closed/2590.v deleted file mode 100644 index 4300de16e0..0000000000 --- a/test-suite/bugs/closed/2590.v +++ /dev/null @@ -1,20 +0,0 @@ -Require Import TestSuite.admit. -Require Import Relation_Definitions RelationClasses Setoid SetoidClass. - -Section Bug. - - Context {A : Type} (R : relation A). - Hypothesis pre : PreOrder R. - Context `{SA : Setoid A}. - - Goal True. - set (SA' := SA). - assert ( forall SA0 : Setoid A, - @PartialOrder A (@equiv A SA0) (@setoid_equiv A SA0) R pre ). - rename SA into SA0. - intro SA. - admit. - admit. -Qed. -End Bug. - diff --git a/test-suite/bugs/closed/2602.v b/test-suite/bugs/closed/2602.v deleted file mode 100644 index 29c8ac16b2..0000000000 --- a/test-suite/bugs/closed/2602.v +++ /dev/null @@ -1,8 +0,0 @@ -Goal exists m, S m > 0. -eexists. -match goal with - | |- context [ S ?a ] => - match goal with - | |- S a > 0 => idtac - end -end. diff --git a/test-suite/bugs/closed/2603.v b/test-suite/bugs/closed/2603.v deleted file mode 100644 index 371bfdc575..0000000000 --- a/test-suite/bugs/closed/2603.v +++ /dev/null @@ -1,33 +0,0 @@ -(** Namespace of module vs. namescope of definitions/constructors/... - -As noticed by A. Appel in bug #2603, module names and definition -names used to be in the same namespace. But conflict with names -of constructors (or 2nd mutual inductive...) used to not be checked -enough, leading to stange situations. - -- In 8.3pl3 we introduced checks that forbid uniformly the following - situations. - -- For 8.4 we finally managed to make module names and other names - live in two separate namespace, hence allowing all of the following - situations. -*) - -Module Type T. -End T. - -Declare Module K : T. - -Module Type L. -Declare Module E : T. -End L. - -Module M1 : L with Module E:=K. -Module E := K. -Inductive t := E. (* Used to be accepted, but End M1 below was failing *) -End M1. - -Module M2 : L with Module E:=K. -Inductive t := E. -Module E := K. (* Used to be accepted *) -End M2. (* Used to be accepted *) diff --git a/test-suite/bugs/closed/2608.v b/test-suite/bugs/closed/2608.v deleted file mode 100644 index a4c95ff97c..0000000000 --- a/test-suite/bugs/closed/2608.v +++ /dev/null @@ -1,34 +0,0 @@ - -Module Type T. - Parameter Inline t : Type. -End T. - -Module M. - Definition t := nat. -End M. - -Module Make (X:T). - Include X. - - (* here t is : (Top.Make.t,Top.X.t) *) - - (* in libobject HEAD : EvalConstRef (Top.X.t,Top.X.t) - which is substituted by : {Top.X |-> Top.Make [, Top.Make.t=>Top.X.t]} - which gives : EvalConstRef (Top.Make.t,Top.X.t) *) - -End Make. - -Module P := Make M. - - (* resolver returned by add_module : Top.P.t=>inline *) - (* then constant_of_delta_kn P.t produces (Top.P.t,Top.P.t) *) - - (* in libobject HEAD : EvalConstRef (Top.Make.t,Top.X.t) - given to subst = { |-> Top.M [, Top.M.t=>inline]} - which used to give : EvalConstRef (Top.Make.t,Top.M.t) - given to subst = {Top.Make |-> Top.P [, Top.P.t=>inline]} - which used to give : EvalConstRef (Top.P.t,Top.M.t) *) - -Definition u := P.t. - (* was raising Not_found since Heads.head_map knows of (Top.P.t,Top.M.t) - and not of (Top.P.t,Top.P.t) *) diff --git a/test-suite/bugs/closed/2613.v b/test-suite/bugs/closed/2613.v deleted file mode 100644 index 15f3bf52c3..0000000000 --- a/test-suite/bugs/closed/2613.v +++ /dev/null @@ -1,18 +0,0 @@ -Require Import TestSuite.admit. -(* Check that eq_sym is still pointing to Logic.eq_sym after use of Function *) - -Require Import ZArith. -Require Recdef. - -Axiom nat_eq_dec: forall x y : nat, {x=y}+{x<>y}. - -Locate eq_sym. (* Constant Coq.Init.Logic.eq_sym *) - -Function loop (n: nat) {measure (fun x => x) n} : bool := - if nat_eq_dec n 0 then false else loop (pred n). -Proof. - admit. -Defined. - -Check eq_sym eq_refl : 0=0. - diff --git a/test-suite/bugs/closed/2615.v b/test-suite/bugs/closed/2615.v deleted file mode 100644 index 26c0f334d0..0000000000 --- a/test-suite/bugs/closed/2615.v +++ /dev/null @@ -1,17 +0,0 @@ -Require Import TestSuite.admit. -(* This failed with an anomaly in pre-8.4 because of let-in not - properly taken into account in the test for unification pattern *) - -Inductive foo : forall A, A -> Prop := -| foo_intro : forall A x, foo A x. -Lemma bar A B f : foo (A -> B) f -> forall x : A, foo B (f x). -Fail induction 1. - -(* Whether these examples should succeed with a non-dependent return predicate - or fail because there is well-typed return predicate dependent in f - is questionable. As of 25 oct 2011, they succeed *) -refine (fun p => match p with _ => _ end). -Undo. -refine (fun p => match p with foo_intro _ _ => _ end). -admit. -Qed. diff --git a/test-suite/bugs/closed/2616.v b/test-suite/bugs/closed/2616.v deleted file mode 100644 index 8758e32dd8..0000000000 --- a/test-suite/bugs/closed/2616.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Testing ill-typed rewrite which used to succeed in 8.3 *) -Goal - forall (N : nat -> Prop) (g : nat -> sig N) (IN : forall a : sig N, a = g 0), - N 0 -> False. -Proof. -intros. -Fail rewrite IN in H. diff --git a/test-suite/bugs/closed/2629.v b/test-suite/bugs/closed/2629.v deleted file mode 100644 index 759cd3dd28..0000000000 --- a/test-suite/bugs/closed/2629.v +++ /dev/null @@ -1,22 +0,0 @@ -Class Join (t: Type) : Type := mkJoin {join: t -> t -> t -> Prop}. - -Class sepalg (t: Type) {JOIN: Join t} : Type := - SepAlg { - join_eq: forall {x y z z'}, join x y z -> join x y z' -> z = z'; - join_assoc: forall {a b c d e}, join a b d -> join d c e -> - {f : t & join b c f /\ join a f e}; - join_com: forall {a b c}, join a b c -> join b a c; - join_canc: forall {a1 a2 b c}, join a1 b c -> join a2 b c -> a1=a2; - - unit_for : t -> t -> Prop := fun e a => join e a a; - join_ex_units: forall a, {e : t & unit_for e a} -}. - -Definition joins {A} `{Join A} (a b : A) : Prop := - exists c, join a b c. - -Lemma join_joins {A} `{sepalg A}: forall {a b c}, - join a b c -> joins a b. -Proof. - firstorder. -Qed. diff --git a/test-suite/bugs/closed/2667.v b/test-suite/bugs/closed/2667.v deleted file mode 100644 index 0e6d0108cc..0000000000 --- a/test-suite/bugs/closed/2667.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Check that extra arguments to Arguments do not disturb use of *) -(* scopes in constructors *) - -Inductive stmt : Type := Sskip: stmt | Scall : nat -> stmt. -Bind Scope Cminor with stmt. - -(* extra argument is ok because of possible coercion to funclass *) -Arguments Scall _ _%Cminor : extra scopes. - -(* extra argument is ok because of possible coercion to funclass *) -Fixpoint f (c: stmt) : Prop := match c with Scall _ => False | _ => False end. diff --git a/test-suite/bugs/closed/2668.v b/test-suite/bugs/closed/2668.v deleted file mode 100644 index d5bbfd3f08..0000000000 --- a/test-suite/bugs/closed/2668.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import MSetPositive. -Require Import MSetProperties. - -Module Pos := MSetPositive.PositiveSet. -Module PPPP := MSetProperties.WPropertiesOn(Pos). -Print Module PPPP. diff --git a/test-suite/bugs/closed/2670.v b/test-suite/bugs/closed/2670.v deleted file mode 100644 index 791889b24b..0000000000 --- a/test-suite/bugs/closed/2670.v +++ /dev/null @@ -1,29 +0,0 @@ -(* Check that problems with several solutions are solved in 8.4 as in 8.2 and 8.3 *) - -Inductive Fin: nat -> Set := -| first k : Fin (S k) -| succ k: Fin k -> Fin (S k). - -Lemma match_sym_eq_eq: forall (n1 n2: nat)(f: Fin n1)(e: n1 = n2), -f = match sym_eq e in (_ = l) return (Fin l) with refl_equal => - match e in (_ = l) return (Fin l) with refl_equal => f end end. -Proof. - intros n1 n2 f e. - (* Next line has a dependent and a non dependent solution *) - (* 8.2 and 8.3 used to choose the dependent one which is the one to make *) - (* the goal progress *) - refine (match e return _ with refl_equal => _ end). - reflexivity. - Undo 2. - (** Check insensitivity to alphabetic order *) - refine (match e as a in _ = b return _ with refl_equal => _ end). - reflexivity. - Undo 2. - (** Check insensitivity to alphabetic order *) - refine (match e as z in _ = y return _ with refl_equal => _ end). - reflexivity. - Undo 2. - (* Next line similarly has a dependent and a non dependent solution *) - refine (match e with refl_equal => _ end). - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/2680.v b/test-suite/bugs/closed/2680.v deleted file mode 100644 index 0f573a2898..0000000000 --- a/test-suite/bugs/closed/2680.v +++ /dev/null @@ -1,17 +0,0 @@ -(* Tauto bug initially due to wrong test for binary connective *) - -Parameter A B : Type. - -Axiom P : A -> B -> Prop. - -Inductive IP (a : A) (b: B) : Prop := -| IP_def : P a b -> IP a b. - - -Goal forall (a : A) (b : B), IP a b -> ~ IP a b -> False. -Proof. - intros. - tauto. -Qed. - - diff --git a/test-suite/bugs/closed/2713.v b/test-suite/bugs/closed/2713.v deleted file mode 100644 index b5fc74bfa7..0000000000 --- a/test-suite/bugs/closed/2713.v +++ /dev/null @@ -1,17 +0,0 @@ -Set Implicit Arguments. - -Definition pred_le A (P Q : A->Prop) := - forall x, P x -> Q x. - -Lemma pred_le_refl : forall A (P:A->Prop), - pred_le P P. -Proof. unfold pred_le. auto. Qed. - -Hint Resolve pred_le_refl. - -Lemma test : - forall (P1 P2:nat->Prop), - (forall Q, pred_le (fun a => P1 a /\ P2 a) Q -> True) -> - True. -Proof. intros. eapply H. eauto. (* used to work *) - apply pred_le_refl. Qed. diff --git a/test-suite/bugs/closed/2729.v b/test-suite/bugs/closed/2729.v deleted file mode 100644 index c9d65c12c7..0000000000 --- a/test-suite/bugs/closed/2729.v +++ /dev/null @@ -1,115 +0,0 @@ -(* This bug report actually revealed two bugs in the reconstruction of - a term with "match" in the vm *) - -(* A simplified form of the first problem *) - -(* Reconstruction of terms normalized with vm when a constructor has *) -(* let-ins arguments *) - -Record A : Type := C { a := 0 : nat; b : a=a }. -Goal forall d:A, match d with C a b => b end = match d with C a b => b end. -intro. -vm_compute. -(* Now check that it is well-typed *) -match goal with |- ?c = _ => first [let x := type of c in idtac | fail 2] end. -Abort. - -(* A simplified form of the second problem *) - -Parameter P : nat -> Type. - -Inductive box A := Box : A -> box A. - -Axiom com : {m : nat & box (P m) }. - -Lemma L : - (let (w, s) as com' return (com' = com -> Prop) := com in - let (s0) as s0 - return (existT (fun m : nat => box (P m)) w s0 = com -> Prop) := s in - fun _ : existT (fun m : nat => box (P m)) w (Box (P w) s0) = com => - True) eq_refl. -Proof. -vm_compute. -(* Now check that it is well-typed (the "P w" used to be turned into "P s") *) -match goal with |- ?c => first [let x := type of c in idtac | fail 2] end. -Abort. - -(* Then the original report *) - -Require Import Equality. - -Parameter NameSet : Set. -Parameter SignedName : Set. -Parameter SignedName_compare : forall (x y : SignedName), comparison. -Parameter pu_type : NameSet -> NameSet -> Type. -Parameter pu_nameOf : forall {from to : NameSet}, pu_type from to -> SignedName. -Parameter commute : forall {from mid1 mid2 to : NameSet}, - pu_type from mid1 -> pu_type mid1 to - -> pu_type from mid2 -> pu_type mid2 to -> Prop. - -Program Definition castPatchFrom {from from' to : NameSet} - (HeqFrom : from = from') - (p : pu_type from to) - : pu_type from' to - := p. - -Class PatchUniverse : Type := mkPatchUniverse { - - commutable : forall {from mid1 to : NameSet}, - pu_type from mid1 -> pu_type mid1 to -> Prop - := fun {from mid1 to : NameSet} - (p : pu_type from mid1) (q : pu_type mid1 to) => - exists mid2 : NameSet, - exists q' : pu_type from mid2, - exists p' : pu_type mid2 to, - commute p q q' p'; - - commutable_dec : forall {from mid to : NameSet} - (p : pu_type from mid) - (q : pu_type mid to), - {mid2 : NameSet & - { q' : pu_type from mid2 & - { p' : pu_type mid2 to & - commute p q q' p' }}} - + {~(commutable p q)} -}. - -Inductive SequenceBase (pu : PatchUniverse) - : NameSet -> NameSet -> Type - := Nil : forall {cxt : NameSet}, - SequenceBase pu cxt cxt - | Cons : forall {from mid to : NameSet} - (p : pu_type from mid) - (qs : SequenceBase pu mid to), - SequenceBase pu from to. -Arguments Nil [pu cxt]. -Arguments Cons [pu from mid to]. - -Program Fixpoint insertBase {pu : PatchUniverse} - {from mid to : NameSet} - (p : pu_type from mid) - (qs : SequenceBase pu mid to) - : SequenceBase pu from to - := match qs with - | Nil => Cons p Nil - | Cons q qs' => - match SignedName_compare (pu_nameOf p) (pu_nameOf q) with - | Lt => Cons p qs - | _ => match commutable_dec p (castPatchFrom _ q) with - | inleft (existT _ _ (existT _ q' (existT _ p' _))) => Cons q' -(insertBase p' qs') - | inright _ => Cons p qs - end - end - end. - -Lemma insertBaseConsLt {pu : PatchUniverse} - {o op opq opqr : NameSet} - (p : pu_type o op) - (q : pu_type op opq) - (rs : SequenceBase pu opq opqr) - (p_Lt_q : SignedName_compare (pu_nameOf p) (pu_nameOf q) -= Lt) - : insertBase p (Cons q rs) = Cons p (Cons q rs). -Proof. -vm_compute. diff --git a/test-suite/bugs/closed/2732.v b/test-suite/bugs/closed/2732.v deleted file mode 100644 index f22a8cccc5..0000000000 --- a/test-suite/bugs/closed/2732.v +++ /dev/null @@ -1,19 +0,0 @@ -(* Check correct behavior of add_primitive_tactic in TACEXTEND *) - -(* Added also the case of eauto and congruence *) - -Ltac thus H := solve [H]. - -Lemma test: forall n : nat, n <= n. -Proof. - intro. - thus firstorder. - Undo. - thus eauto. -Qed. - -Lemma test2: false = true -> False. -Proof. - intro. - thus congruence. -Qed. diff --git a/test-suite/bugs/closed/2733.v b/test-suite/bugs/closed/2733.v deleted file mode 100644 index 24dd30b32e..0000000000 --- a/test-suite/bugs/closed/2733.v +++ /dev/null @@ -1,43 +0,0 @@ -Unset Asymmetric Patterns. - -Definition goodid : forall {A} (x: A), A := fun A x => x. -Definition wrongid : forall A (x: A), A := fun {A} x => x. - -Inductive ty := N | B. - -Inductive alt_list : ty -> ty -> Type := - | nil {k} : alt_list k k - | Ncons {k} : nat -> alt_list B k -> alt_list N k - | Bcons {k} : bool -> alt_list N k -> alt_list B k. - -Definition trullynul k {k'} (l : alt_list k k') := -match k,l with - |N,l' => Ncons 0 (Bcons true l') - |B,l' => Bcons true (Ncons 0 l') -end. - -(* At some time, the success of trullynul was dependent on the name of - the variables! *) - -Definition trullynul2 k {a} (l : alt_list k a) := -match k,l with - |N,l' => Ncons 0 (Bcons true l') - |B,l' => Bcons true (Ncons 0 l') -end. - -Definition trullynul3 k {z} (l : alt_list k z) := -match k,l with - |N,l' => Ncons 0 (Bcons true l') - |B,l' => Bcons true (Ncons 0 l') -end. - -Fixpoint app (P : forall {k k'}, alt_list k k' -> alt_list k k') {t1 t2} (l : alt_list t1 t2) {struct l}: forall {t3}, alt_list t2 t3 -> -alt_list t1 t3 := - match l with - | nil => fun _ l2 => P l2 - | Ncons n l1 => fun _ l2 => Ncons n (app (@P) l1 l2) - | Bcons b l1 => fun _ l2 => Bcons b (app (@P) l1 l2) - end. - -Check (fun {t t'} (l: alt_list t t') => - app trullynul (goodid l) (wrongid _ nil)). diff --git a/test-suite/bugs/closed/2734.v b/test-suite/bugs/closed/2734.v deleted file mode 100644 index 3210214ea1..0000000000 --- a/test-suite/bugs/closed/2734.v +++ /dev/null @@ -1,15 +0,0 @@ -Require Import Arith List. -Require Import OrderedTypeEx. - -Module Adr. - Include Nat_as_OT. - Definition nat2t (i: nat) : t := i. -End Adr. - -Inductive expr := Const: Adr.t -> expr. - -Inductive control := Go: expr -> control. - -Definition program := (Adr.t * (control))%type. - -Fail Definition myprog : program := (Adr.nat2t 0, Go (Adr.nat2t 0) ). diff --git a/test-suite/bugs/closed/2750.v b/test-suite/bugs/closed/2750.v deleted file mode 100644 index 9d65e51f63..0000000000 --- a/test-suite/bugs/closed/2750.v +++ /dev/null @@ -1,23 +0,0 @@ - -Module Type ModWithRecord. - - Record foo : Type := - { A : nat - ; B : nat - }. -End ModWithRecord. - -Module Test_ModWithRecord (M : ModWithRecord). - - Definition test1 : M.foo := - {| M.A := 0 - ; M.B := 2 - |}. - - Module B := M. - - Definition test2 : M.foo := - {| M.A := 0 - ; M.B := 2 - |}. -End Test_ModWithRecord. diff --git a/test-suite/bugs/closed/2775.v b/test-suite/bugs/closed/2775.v deleted file mode 100644 index f1f384bdf7..0000000000 --- a/test-suite/bugs/closed/2775.v +++ /dev/null @@ -1,6 +0,0 @@ -Inductive typ : forall (T:Type), list T -> Type -> Prop := - | Get : forall (T:Type) (l:list T), typ T l T. - - -Derive Inversion inv with -(forall (X: Type) (y: list nat), typ nat y X) Sort Prop. diff --git a/test-suite/bugs/closed/2800.v b/test-suite/bugs/closed/2800.v deleted file mode 100644 index 54c75e344c..0000000000 --- a/test-suite/bugs/closed/2800.v +++ /dev/null @@ -1,19 +0,0 @@ -Goal False. - -intuition - match goal with - | |- _ => idtac " foo" - end. - - lazymatch goal with _ => idtac end. - match goal with _ => idtac end. - unshelve lazymatch goal with _ => idtac end. - unshelve match goal with _ => idtac end. - unshelve (let x := I in idtac). -Abort. - -Require Import ssreflect. - -Goal True. -match goal with _ => idtac end => //. -Qed. diff --git a/test-suite/bugs/closed/2810.v b/test-suite/bugs/closed/2810.v deleted file mode 100644 index a66078c60a..0000000000 --- a/test-suite/bugs/closed/2810.v +++ /dev/null @@ -1,10 +0,0 @@ -Section foo. - Variable A : Type. - Let B := A. - - Hint Unfold B. - - Goal False. - clear B. autounfold with core. - Abort. -End foo. diff --git a/test-suite/bugs/closed/2814.v b/test-suite/bugs/closed/2814.v deleted file mode 100644 index 99da1e3e44..0000000000 --- a/test-suite/bugs/closed/2814.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import Program. - -Goal forall (x : Type) (f g : Type -> Type) (H : f x ~= g x), False. - intros. - Fail induction H. -Abort. diff --git a/test-suite/bugs/closed/2817.v b/test-suite/bugs/closed/2817.v deleted file mode 100644 index 08dff99287..0000000000 --- a/test-suite/bugs/closed/2817.v +++ /dev/null @@ -1,9 +0,0 @@ -(** Occur-check for Meta (up to application of already known instances) *) - -Goal forall (f: nat -> nat -> Prop) (x:bool) - (H: forall (u: nat), f u u -> True) - (H0: forall x0, f (if x then x0 else x0) x0), -False. - -intros. -Fail apply H in H0. (* should fail without exhausting the stack *) diff --git a/test-suite/bugs/closed/2818.v b/test-suite/bugs/closed/2818.v deleted file mode 100644 index 010855cfb7..0000000000 --- a/test-suite/bugs/closed/2818.v +++ /dev/null @@ -1,11 +0,0 @@ -Module M. - -Local Ltac t := exact I. -Ltac u := t. - -End M. - -Goal True. -Proof. -M.u. -Qed. diff --git a/test-suite/bugs/closed/2828.v b/test-suite/bugs/closed/2828.v deleted file mode 100644 index 0b8abace22..0000000000 --- a/test-suite/bugs/closed/2828.v +++ /dev/null @@ -1,4 +0,0 @@ -Parameter A B : Type. -Coercion POL (p : prod A B) := fst p. -Goal forall x : prod A B, A. - intro x. Fail exact x. diff --git a/test-suite/bugs/closed/2830.v b/test-suite/bugs/closed/2830.v deleted file mode 100644 index 07a5cf91a5..0000000000 --- a/test-suite/bugs/closed/2830.v +++ /dev/null @@ -1,227 +0,0 @@ -(* Bug report #2830 (evar defined twice) covers different bugs *) - -(* 1- This was submitted by qb.h.agws *) - -Module A. - -Set Implicit Arguments. - -Inductive Bit := O | I. - -Inductive BitString: nat -> Set := -| bit: Bit -> BitString 0 -| bitStr: forall n: nat, Bit -> BitString n -> BitString (S n). - -Definition BitOr (a b: Bit) := - match a, b with - | O, O => O - | _, _ => I - end. - -(* Should fail with an error; used to failed in 8.4 and trunk with - anomaly Evd.define: cannot define an evar twice *) - -Fail Fixpoint StringOr (n m: nat) (a: BitString n) (b: BitString m) := - match a with - | bit a' => - match b with - | bit b' => bit (BitOr a' b') - | bitStr b' bT => bitStr b' (StringOr (bit a') bT) - end - | bitStr a' aT => - match b with - | bit b' => bitStr a' (StringOr aT (bit b')) - | bitStr b' bT => bitStr (BitOr a' b') (StringOr aT bT) - end - end. - -End A. - -(* 2- This was submitted by Andrew Appel *) - -Module B. - -Require Import Program Relations. - -Record ageable_facts (A:Type) (level: A -> nat) (age1:A -> option A) := -{ af_unage : forall x x' y', level x' = level y' -> age1 x = Some x' -> exists y, age1 y = Some y' -; af_level1 : forall x, age1 x = None <-> level x = 0 -; af_level2 : forall x y, age1 x = Some y -> level x = S (level y) -}. - -Arguments af_unage {A level age1}. -Arguments af_level1 {A level age1}. -Arguments af_level2 {A level age1}. - -Class ageable (A:Type) := mkAgeable -{ level : A -> nat -; age1 : A -> option A -; age_facts : ageable_facts A level age1 -}. -Definition age {A} `{ageable A} (x y:A) := age1 x = Some y. -Definition necR {A} `{ageable A} : relation A := clos_refl_trans A age. -Delimit Scope pred with pred. -Local Open Scope pred. - -Definition hereditary {A} (R:A->A->Prop) (p:A->Prop) := - forall a a':A, R a a' -> p a -> p a'. - -Definition pred (A:Type) {AG:ageable A} := - { p:A -> Prop | hereditary age p }. - -Bind Scope pred with pred. - -Definition app_pred {A} `{ageable A} (p:pred A) : A -> Prop := proj1_sig p. -Definition pred_hereditary `{ageable} (p:pred A) := proj2_sig p. -Coercion app_pred : pred >-> Funclass. -Global Opaque pred. - -Definition derives {A} `{ageable A} (P Q:pred A) := forall a:A, P a -> Q a. -Arguments derives : default implicits. - -Program Definition andp {A} `{ageable A} (P Q:pred A) : pred A := - fun a:A => P a /\ Q a. -Next Obligation. - intros; intro; intuition; apply pred_hereditary with a; auto. -Qed. - -Program Definition imp {A} `{ageable A} (P Q:pred A) : pred A := - fun a:A => forall a':A, necR a a' -> P a' -> Q a'. -Next Obligation. - intros; intro; intuition. - apply H1; auto. - apply rt_trans with a'; auto. - apply rt_step; auto. -Qed. - -Program Definition allp {A} `{ageable A} {B: Type} (f: B -> pred A) : pred A - := fun a => forall b, f b a. -Next Obligation. - intros; intro; intuition. - apply pred_hereditary with a; auto. - apply H1. -Qed. - -Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : pred. -Notation "P '|--' Q" := (derives P Q) (at level 80, no associativity). -Notation "'All' x ':' T ',' P " := (allp (fun x:T => P%pred)) (at level 65, x at level 99) : pred. - -Lemma forall_pred_ext {A} `{agA : ageable A}: forall B P Q, - (All x : B, (P x <--> Q x)) |-- (All x : B, P x) <--> (All x: B, Q x). -Abort. - -End B. - -(* 3. *) - -(* This was submitted by Anthony Cowley *) - -Require Import Coq.Classes.Morphisms. -Require Import Setoid. - -Module C. - -Reserved Notation "a ~> b" (at level 70, right associativity). -Reserved Notation "a ≈ b" (at level 54). -Reserved Notation "a ∘ b" (at level 50, left associativity). -Generalizable All Variables. - -Class Category (Object:Type) (Hom:Object -> Object -> Type) := { - hom := Hom where "a ~> b" := (hom a b) : category_scope - ; ob := Object - ; id : forall a, hom a a - ; comp : forall c b a, hom b c -> hom a b -> hom a c - where "g ∘ f" := (comp _ _ _ g f) : category_scope - ; eqv : forall a b, hom a b -> hom a b -> Prop - where "f ≈ g" := (eqv _ _ f g) : category_scope - ; eqv_equivalence : forall a b, Equivalence (eqv a b) - ; comp_respects : forall a b c, - Proper (eqv b c ==> eqv a b ==> eqv a c) (comp c b a) - ; left_identity : forall `(f:a ~> b), id b ∘ f ≈ f - ; right_identity : forall `(f:a ~> b), f ∘ id a ≈ f - ; associativity : forall `(f:a~>b) `(g:b~>c) `(h:c~>d), - h ∘ (g ∘ f) ≈ (h ∘ g) ∘ f -}. -Notation "a ~> b" := (@hom _ _ _ a b) : category_scope. -Notation "g ∘ f" := (@comp _ _ _ _ _ _ g f) : category_scope. -Notation "a ≈ b" := (@eqv _ _ _ _ _ a b) : category_scope. -Notation "a ~{ C }~> b" := (@hom _ _ C a b) (at level 100) : category_scope. -Coercion ob : Category >-> Sortclass. - -Open Scope category_scope. - -Add Parametric Relation `(C:Category Ob Hom) (a b : Ob) : (hom a b) (eqv a b) - reflexivity proved by (@Equivalence_Reflexive _ _ (eqv_equivalence a b)) - symmetry proved by (@Equivalence_Symmetric _ _ (eqv_equivalence a b)) - transitivity proved by (@Equivalence_Transitive _ _ (eqv_equivalence a b)) - as parametric_relation_eqv. - -Add Parametric Morphism `(C:Category Ob Hom) (c b a : Ob) : (comp c b a) - with signature (eqv _ _ ==> eqv _ _ ==> eqv _ _) as parametric_morphism_comp. - intros x y Heq x' y'. apply comp_respects. exact Heq. - Defined. - -Class Functor `(C:Category) `(D:Category) (im : C -> D) := { - functor_im := im - ; fmap : forall {a b}, `(a ~> b) -> im a ~> im b - ; fmap_respects : forall a b (f f' : a ~> b), f ≈ f' -> fmap f ≈ fmap f' - ; fmap_preserves_id : forall a, fmap (id a) ≈ id (im a) - ; fmap_preserves_comp : forall `(f:a~>b) `(g:b~>c), - fmap g ∘ fmap f ≈ fmap (g ∘ f) -}. -Coercion functor_im : Functor >-> Funclass. -Arguments fmap [Object Hom C Object0 Hom0 D im] _ [a b]. - -Add Parametric Morphism `(C:Category) `(D:Category) - (Im:C->D) (F:Functor C D Im) (a b:C) : (@fmap _ _ C _ _ D Im F a b) - with signature (@eqv C _ C a b ==> @eqv D _ D (Im a) (Im b)) - as parametric_morphism_fmap. -intros. apply fmap_respects. assumption. Qed. - -(* HERE IS THE PROBLEMATIC INSTANCE. If we change this to a regular Definition, - then the problem goes away. *) -Instance functor_comp `{C:Category} `{D:Category} `{E:Category} - {Gim} (G:Functor D E Gim) {Fim} (F:Functor C D Fim) - : Functor C E (Basics.compose Gim Fim). -intros. apply Build_Functor with (fmap := fun a b f => fmap G (fmap F f)). -abstract (intros; rewrite H; reflexivity). -abstract (intros; repeat (rewrite fmap_preserves_id); reflexivity). -abstract (intros; repeat (rewrite fmap_preserves_comp); reflexivity). -Defined. - -Definition skel {A:Type} : relation A := @eq A. -Instance skel_equiv A : Equivalence (@skel A). -Admitted. - -Import FunctionalExtensionality. -Instance set_cat : Category Type (fun A B => A -> B) := { - id := fun A => fun x => x - ; comp c b a f g := fun x => f (g x) - ; eqv := fun A B => @skel (A -> B) -}. -intros. compute. symmetry. apply eta_expansion. -intros. compute. symmetry. apply eta_expansion. -intros. compute. reflexivity. Defined. - -(* The [list] type constructor is a Functor. *) - -Import List. - -Definition setList (A:set_cat) := list A. -Instance list_functor : Functor set_cat set_cat setList. -apply Build_Functor with (fmap := @map). -intros. rewrite H. reflexivity. -intros; simpl; apply functional_extensionality. - induction x; [auto|simpl]. rewrite IHx. reflexivity. -intros; simpl; apply functional_extensionality. - induction x; [auto|simpl]. rewrite IHx. reflexivity. -Defined. - -Local Notation "[ a , .. , b ]" := (a :: .. (b :: nil) ..) : list_scope. -Definition setFmap {Fim} {F:Functor set_cat set_cat Fim} `(f:A~>B) (xs:Fim A) := fmap F f xs. - -(* We want to infer the [Functor] instance based on the value's - structure, but the [functor_comp] instance throws things awry. *) -Eval cbv in setFmap (fun x => x * 3) [67,8]. - -End C. diff --git a/test-suite/bugs/closed/2834.v b/test-suite/bugs/closed/2834.v deleted file mode 100644 index 6015c53b8a..0000000000 --- a/test-suite/bugs/closed/2834.v +++ /dev/null @@ -1,4 +0,0 @@ -(* Testing typing of subst *) - -Lemma eqType2Set (a b : Set) (H : @eq Type a b) : @eq Set a b. -Fail subst. diff --git a/test-suite/bugs/closed/2836.v b/test-suite/bugs/closed/2836.v deleted file mode 100644 index a948b75e27..0000000000 --- a/test-suite/bugs/closed/2836.v +++ /dev/null @@ -1,39 +0,0 @@ -(* Check that possible instantiation made during evar materialization - are taken into account and do not raise Not_found *) - -Set Implicit Arguments. - -Record SpecializedCategory (obj : Type) (Morphism : obj -> obj -> Type) := { - Object :> _ := obj; - - Identity' : forall o, Morphism o o; - Compose' : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' -}. - -Section SpecializedCategoryInterface. - Variable obj : Type. - Variable mor : obj -> obj -> Type. - Variable C : @SpecializedCategory obj mor. - - Definition Morphism (s d : C) := mor s d. - Definition Identity (o : C) : Morphism o o := C.(Identity') o. - Definition Compose (s d d' : C) (m : Morphism d d') (m0 : Morphism s d) : -Morphism s d' := C.(Compose') s d d' m m0. -End SpecializedCategoryInterface. - -Section ProductCategory. - Variable objC : Type. - Variable morC : objC -> objC -> Type. - Variable objD : Type. - Variable morD : objD -> objD -> Type. - Variable C : SpecializedCategory morC. - Variable D : SpecializedCategory morD. - -(* Should fail nicely *) -Definition ProductCategory : @SpecializedCategory (objC * objD)%type (fun s d -=> (morC (fst s) (fst d) * morD (snd s) (snd d))%type). -Fail refine {| - Identity' := (fun o => (Identity (fst o), Identity (snd o))); - Compose' := (fun s d d' m2 m1 => (Compose (fst m2) (fst m1), Compose (snd -m2) (snd m1))) - |}. diff --git a/test-suite/bugs/closed/2837.v b/test-suite/bugs/closed/2837.v deleted file mode 100644 index 52a56c2cff..0000000000 --- a/test-suite/bugs/closed/2837.v +++ /dev/null @@ -1,15 +0,0 @@ -Require Import JMeq. - -Axiom test : forall n m : nat, JMeq n m. - -Goal forall n m : nat, JMeq n m. - -(* I) with no intros nor variable hints, this should produce a regular error - instead of Uncaught exception Failure("nth"). *) -Fail rewrite test. - -(* II) with intros but indication of variables, still an error *) -Fail (intros; rewrite test). - -(* III) a working variant: *) -intros; rewrite (test n m). diff --git a/test-suite/bugs/closed/2839.v b/test-suite/bugs/closed/2839.v deleted file mode 100644 index e727e26061..0000000000 --- a/test-suite/bugs/closed/2839.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Check a case where ltac typing error should result in error, not anomaly *) - -Goal forall (H : forall x : nat, x = x), False. -intro. -Fail - let H := - match goal with - | [ H : context G [@eq _ _] |- _ ] => let H' := context G[@plus 2] in H' - end - in pose H. diff --git a/test-suite/bugs/closed/2846.v b/test-suite/bugs/closed/2846.v deleted file mode 100644 index 8d6d348a2e..0000000000 --- a/test-suite/bugs/closed/2846.v +++ /dev/null @@ -1,3 +0,0 @@ -Variable R : Type. - -Fail Inductive I : R := c : R. diff --git a/test-suite/bugs/closed/2848.v b/test-suite/bugs/closed/2848.v deleted file mode 100644 index e234630332..0000000000 --- a/test-suite/bugs/closed/2848.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import Setoid. - -Parameter value' : Type. -Parameter equiv' : value' -> value' -> Prop. -Axiom cheat : forall {A}, A. -Add Parametric Relation : _ equiv' - reflexivity proved by (Equivalence.equiv_reflexive cheat) - transitivity proved by (Equivalence.equiv_transitive cheat) - as apply_equiv'_rel. -Check apply_equiv'_rel : PreOrder equiv'. diff --git a/test-suite/bugs/closed/2854.v b/test-suite/bugs/closed/2854.v deleted file mode 100644 index 14aee17ff0..0000000000 --- a/test-suite/bugs/closed/2854.v +++ /dev/null @@ -1,7 +0,0 @@ -Section foo. - Let foo := Type. - Definition bar : foo -> foo := @id _. - Goal False. - subst foo. - Fail pose bar as f. - (* simpl in f. *) diff --git a/test-suite/bugs/closed/2876.v b/test-suite/bugs/closed/2876.v deleted file mode 100644 index a66ee6b3fa..0000000000 --- a/test-suite/bugs/closed/2876.v +++ /dev/null @@ -1,11 +0,0 @@ -Lemma test_bug : forall (R:nat->nat->Prop) n m m' (P: Prop), - P -> - (P -> R n m) -> - (P -> R n m') -> - (forall u, R n u -> u = u -> True) -> - True. -Proof. - intros * HP H1 H2 H3. eapply H3. - eauto. (* H1 is used, but H2 should be used since it is the last hypothesis *) - auto. -Qed. diff --git a/test-suite/bugs/closed/2881.v b/test-suite/bugs/closed/2881.v deleted file mode 100644 index b4f09305b4..0000000000 --- a/test-suite/bugs/closed/2881.v +++ /dev/null @@ -1,7 +0,0 @@ -(* About scoping of pattern variables in strict/non-strict mode *) - -Ltac eta_red := change (fun a => ?f0 a) with f0. -Goal forall T1 T2 (f : T1 -> T2), (fun x => f x) = f. -intros. -eta_red. -Abort. diff --git a/test-suite/bugs/closed/2883.v b/test-suite/bugs/closed/2883.v deleted file mode 100644 index f027b5eb29..0000000000 --- a/test-suite/bugs/closed/2883.v +++ /dev/null @@ -1,35 +0,0 @@ -Require Import TestSuite.admit. -Require Import List. -Require Import Coq.Program.Equality. - -Inductive star {genv state : Type} - (step : genv -> state -> state -> Prop) - (ge : genv) : state -> state -> Prop := - | star_refl : forall s : state, star step ge s s - | star_step : - forall (s1 : state) (s2 : state) - (s3 : state), - step ge s1 s2 -> - star step ge s2 s3 -> - star step ge s1 s3. - -Parameter genv expr env mem : Type. -Definition genv' := genv. -Inductive state : Type := - | State : expr -> env -> mem -> state. -Parameter step : genv' -> state -> state -> Prop. - -Section Test. - -Variable ge : genv'. - -Lemma compat_eval_steps: - forall a b e a' b', - star step ge (State a e b) (State a' e b') -> - True. -Proof. - intros. dependent induction H. - trivial. - eapply IHstar; eauto. - replace s2 with (State a' e b') by admit. eauto. -Qed. (* Oups *) diff --git a/test-suite/bugs/closed/2900.v b/test-suite/bugs/closed/2900.v deleted file mode 100644 index 8f4264e910..0000000000 --- a/test-suite/bugs/closed/2900.v +++ /dev/null @@ -1,28 +0,0 @@ -(* Was raising stack overflow in 8.4 and assertion failed in future 8.5 *) -Set Implicit Arguments. - -Require Import List. -Require Import Coq.Program.Equality. - -(** Reflexive-transitive closure ( R* ) *) - -Inductive rtclosure (A : Type) (R : A-> A->Prop) : A->A->Prop := - | rtclosure_refl : forall x, - rtclosure R x x - | rtclosure_step : forall y x z, - R x y -> rtclosure R y z -> rtclosure R x z. - (* bug goes away if rtclosure_step is commented out *) - -(** The closure of the trivial binary relation [eq] *) - -Definition tr (A:Type) := rtclosure (@eq A). - -(** The bug *) - -Lemma bug : forall A B (l t:list A) (r s:list B), - length l = length r -> - tr (combine l r) (combine t s) -> tr l t. -Proof. - intros * E Hp. - (* bug goes away if [revert E] is called explicitly *) - dependent induction Hp. diff --git a/test-suite/bugs/closed/2920.v b/test-suite/bugs/closed/2920.v deleted file mode 100644 index 13548b9e44..0000000000 --- a/test-suite/bugs/closed/2920.v +++ /dev/null @@ -1,2 +0,0 @@ -Fail Definition my_f_equal {A B : Type} (f : A -> B) (a a' : A) (p : a = a') : f a = f a' := - eq_ind _ _ (fun a' => f a = f a') _ _ p. diff --git a/test-suite/bugs/closed/2923.v b/test-suite/bugs/closed/2923.v deleted file mode 100644 index 8a0003a397..0000000000 --- a/test-suite/bugs/closed/2923.v +++ /dev/null @@ -1,12 +0,0 @@ -Module Type SIGNATURE1. - Inductive IndType: Set := - | AConstructor. -End SIGNATURE1. - -Module Type SIGNATURE2. - Declare Module M1: SIGNATURE1. -End SIGNATURE2. - -Module M2 (Module M1_: SIGNATURE1) : SIGNATURE2. - Module M1 := M1_. -End M2. diff --git a/test-suite/bugs/closed/2928.v b/test-suite/bugs/closed/2928.v deleted file mode 100644 index 21e92ae20c..0000000000 --- a/test-suite/bugs/closed/2928.v +++ /dev/null @@ -1,11 +0,0 @@ -Class Equiv A := equiv: A -> A -> Prop. -Infix "=" := equiv : type_scope. - -Class Associative {A} f `{Equiv A} := associativity x y z : f x (f y z) = f (f x y) z. - -Class SemiGroup A op `{Equiv A} := { sg_ass :>> Associative op }. - -Class SemiLattice A op `{Equiv A} := - { semilattice_sg :>> SemiGroup A op - ; redundant : Associative op - }. diff --git a/test-suite/bugs/closed/2930.v b/test-suite/bugs/closed/2930.v deleted file mode 100644 index 0994b6fb23..0000000000 --- a/test-suite/bugs/closed/2930.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Checking that let-in's hiding evars are expanded when enforcing - "occur-check" *) - -Require Import List. - -Definition foo x y := -let xy := (x, y) in -let bar xys := - match xys with - | nil => xy :: nil - | xy' :: xys' => xy' :: xys' - end in bar (nil : list (nat * nat)). diff --git a/test-suite/bugs/closed/2945.v b/test-suite/bugs/closed/2945.v deleted file mode 100644 index 59b57c07b7..0000000000 --- a/test-suite/bugs/closed/2945.v +++ /dev/null @@ -1,5 +0,0 @@ -Notation "f1 =1 f2 :> A" := (f1 = (f2 : A)) - (at level 70, f2 at next level, A at level 90) : fun_scope. - -Notation "e :? pf" := (eq_rect _ (fun X : _ => X) e _ pf) - (no associativity, at level 90). diff --git a/test-suite/bugs/closed/2946.v b/test-suite/bugs/closed/2946.v deleted file mode 100644 index d8138e145c..0000000000 --- a/test-suite/bugs/closed/2946.v +++ /dev/null @@ -1,8 +0,0 @@ -Lemma toto (E : nat -> nat -> Prop) (x y : nat) - (Ex_ : forall z, E x z) (E_y : forall z, E z y) : True. - -(* OK *) -assert (pairE1 := let Exy := _ in (Ex_ y, E_y _) : Exy * Exy). - -(* FAIL *) -assert (pairE2 := let Exy := _ in (Ex_ _, E_y x) : Exy * Exy). diff --git a/test-suite/bugs/closed/2951.v b/test-suite/bugs/closed/2951.v deleted file mode 100644 index 87d544416d..0000000000 --- a/test-suite/bugs/closed/2951.v +++ /dev/null @@ -1,2 +0,0 @@ -Record C (A: Type) : Type := { f: A }. -Existing Class C. diff --git a/test-suite/bugs/closed/2955.v b/test-suite/bugs/closed/2955.v deleted file mode 100644 index 11fd7bada7..0000000000 --- a/test-suite/bugs/closed/2955.v +++ /dev/null @@ -1,52 +0,0 @@ -Require Import Coq.Arith.Arith. - -Module A. - - Fixpoint foo (n:nat) := - match n with - | 0 => 0 - | S n => bar n - end - - with bar (n:nat) := - match n with - | 0 => 0 - | S n => foo n - end. - - Lemma using_foo: - forall (n:nat), foo n = 0 /\ bar n = 0. - Proof. - induction n ; split ; auto ; - destruct IHn ; auto. - Qed. - -End A. - - -Module B. - - Module A := A. - Import A. - -End B. - -Module E. - - Module B := B. - Import B.A. - - (* Bug 1 *) - Lemma test_1: - forall (n:nat), foo n = 0. - Proof. - intros ; destruct n. - reflexivity. - specialize (A.using_foo (S n)) ; intros. - simpl in H. - simpl. - destruct H. - assumption. - Qed. - -End E. diff --git a/test-suite/bugs/closed/2966.v b/test-suite/bugs/closed/2966.v deleted file mode 100644 index debada8539..0000000000 --- a/test-suite/bugs/closed/2966.v +++ /dev/null @@ -1,79 +0,0 @@ -(** Non-termination and state monad with extraction *) -Require Import List. - -Set Implicit Arguments. -Set Asymmetric Patterns. - -Module MemSig. - Definition t: Type := list Type. - - Definition Nth (sig: t) (n: nat) := - nth n sig unit. -End MemSig. - -(** A memory of type [Mem.t s] is the union of cells whose type is specified - by [s]. *) -Module Mem. - Inductive t: MemSig.t -> Type := - | Nil: t nil - | Cons: forall (T: Type), option T -> forall (sig: MemSig.t), t sig -> - t (T :: sig). -End Mem. - -Module Ref. - Inductive t (sig: MemSig.t) (T: Type): Type := - | Input: t sig T. - - Definition Read (sig: MemSig.t) (T: Type) (ref: t sig T) (s: Mem.t sig) - : option T := - match ref with - | Input => None - end. -End Ref. - -Module Monad. - Definition t (sig: MemSig.t) (A: Type) := - Mem.t sig -> option A * Mem.t sig. - - Definition Return (sig: MemSig.t) (A: Type) (x: A): t sig A := - fun s => - (Some x, s). - - Definition Bind (sig: MemSig.t) (A B: Type) (x: t sig A) (f: A -> t sig B) - : t sig B := - fun s => - match x s with - | (Some x', s') => f x' s' - | (None, s') => (None, s') - end. - - Definition Select (T: Type) (f g: unit -> T): T := - f tt. - - (** Read in a reference. *) - Definition Read (sig: MemSig.t) (T: Type) (ref: Ref.t sig T) - : t sig T := - fun s => - match Ref.Read ref s with - | None => (None, s) - | Some x => (Some x, s) - end. -End Monad. - -Import Monad. - -Definition pop (sig: MemSig.t) (T: Type) (trace: Ref.t sig (list T)) - : Monad.t sig T := - Bind (Read trace) (fun _ s => (None, s)). - -Definition sig: MemSig.t := (list nat: Type) :: nil. - -Definition trace: Ref.t sig (list nat). -Admitted. - -Definition Gre (sig: MemSig.t) (trace: _) - (f: bool -> bool): Monad.t sig nat := - Select (fun _ => pop trace) (fun _ => Return 0). - -Definition Arg := - Gre trace (fun _ => false). diff --git a/test-suite/bugs/closed/2969.v b/test-suite/bugs/closed/2969.v deleted file mode 100644 index 7b1a261789..0000000000 --- a/test-suite/bugs/closed/2969.v +++ /dev/null @@ -1,28 +0,0 @@ -Require Import TestSuite.admit. -(* Check that Goal.V82.byps and Goal.V82.env are consistent *) - -(* This is a shorten variant of the initial bug which raised anomaly *) - -Goal forall x : nat, (forall z, (exists y:nat, z = y) -> True) -> True. -evar nat. -intros x H. -apply (H n). -unfold n. clear n. -eexists. -reflexivity. -Grab Existential Variables. -admit. -Admitted. - -(* Alternative variant which failed but without raising anomaly *) - -Goal forall x : nat, True. -evar nat. -intro x. -evar nat. -assert (H := eq_refl : n0 = n). -clearbody n n0. -exact I. -Grab Existential Variables. -admit. -Admitted. diff --git a/test-suite/bugs/closed/2981.v b/test-suite/bugs/closed/2981.v deleted file mode 100644 index 1facd9b7e9..0000000000 --- a/test-suite/bugs/closed/2981.v +++ /dev/null @@ -1,15 +0,0 @@ -Check let TTT := Type in (fun (a b : @sigT TTT (fun A : TTT => A)) - (f : @projT1 TTT (fun A : TTT => A) a -> - @projT1 TTT (fun A : TTT => A) b) => - @eq_refl - (@projT1 TTT (fun A : TTT => A) a -> - @projT1 TTT (fun A : TTT => A) b) - (fun x : @projT1 TTT (fun A : TTT => A) a => f x)) : - forall (a b : @sigT TTT (fun A : TTT => A)) - (f : @projT1 TTT (fun A : TTT => A) a -> - @projT1 TTT (fun A : TTT => A) b), - @eq - (@projT1 TTT (fun A : TTT => A) a -> - @projT1 TTT (fun A : TTT => A) b) - (fun x : @projT1 TTT (fun A : TTT => A) a => f x) f. - diff --git a/test-suite/bugs/closed/2983.v b/test-suite/bugs/closed/2983.v deleted file mode 100644 index ad76350949..0000000000 --- a/test-suite/bugs/closed/2983.v +++ /dev/null @@ -1,8 +0,0 @@ -Module Type ModA. -End ModA. -Module Type ModB(A : ModA). -End ModB. -Module Foo(A : ModA)(B : ModB A). -End Foo. - -Print Module Foo. diff --git a/test-suite/bugs/closed/2990.v b/test-suite/bugs/closed/2990.v deleted file mode 100644 index 5f832626bc..0000000000 --- a/test-suite/bugs/closed/2990.v +++ /dev/null @@ -1,8 +0,0 @@ -Goal True. -Proof. - evar (pfT : Type). - cut pfT. - subst pfT. - intro pf. - refine ((fun A : Set => pf A) unit). -Abort. diff --git a/test-suite/bugs/closed/2994.v b/test-suite/bugs/closed/2994.v deleted file mode 100644 index 457b1893de..0000000000 --- a/test-suite/bugs/closed/2994.v +++ /dev/null @@ -1,2 +0,0 @@ -(* Was an anomaly at some time *) -Fail Class foo : Prop := { bar :> Set }. diff --git a/test-suite/bugs/closed/2995.v b/test-suite/bugs/closed/2995.v deleted file mode 100644 index b6c5b6df44..0000000000 --- a/test-suite/bugs/closed/2995.v +++ /dev/null @@ -1,9 +0,0 @@ -Module Type Interface. - Parameter error: nat. -End Interface. - -Module Implementation <: Interface. - Definition t := bool. - Definition error: t := false. -Fail End Implementation. -(* A UserError here is expected, not an uncaught Not_found *) diff --git a/test-suite/bugs/closed/2996.v b/test-suite/bugs/closed/2996.v deleted file mode 100644 index d5409289c5..0000000000 --- a/test-suite/bugs/closed/2996.v +++ /dev/null @@ -1,31 +0,0 @@ -Require Import TestSuite.admit. -(* Test on definitions referring to section variables that are not any - longer in the current context *) - -Section x. - - Hypothesis h : forall(n : nat), n < S n. - - Definition f(n m : nat)(less : n < m) : nat := n + m. - - Lemma a : forall(n : nat), f n (S n) (h n) = 1 + 2 * n. - Proof. - (* XXX *) admit. - Qed. - - Lemma b : forall(n : nat), n < 3 + n. - Proof. - clear. - intros n. - Fail assert (H := a n). - Abort. - - Let T := True. - Definition p := I : T. - - Lemma paradox : False. - Proof. - clear. - set (T := False). - Fail pose proof p as H. - Abort. diff --git a/test-suite/bugs/closed/3000.v b/test-suite/bugs/closed/3000.v deleted file mode 100644 index 27de34ed17..0000000000 --- a/test-suite/bugs/closed/3000.v +++ /dev/null @@ -1,2 +0,0 @@ -Inductive t (t':Type) : Type := A | B. -Definition d := match t with _ => 1 end. (* used to fail on list_chop *) diff --git a/test-suite/bugs/closed/3001.v b/test-suite/bugs/closed/3001.v deleted file mode 100644 index 6e56555499..0000000000 --- a/test-suite/bugs/closed/3001.v +++ /dev/null @@ -1,21 +0,0 @@ -Definition my_fun (n:nat) := n. - -Section My_Sec. - Global Arguments my_fun x : rename. -End My_Sec. - -(* The following code suffices to trigger it, on my system: - - Definition my_fun (n:nat) := n. - - Section My_Sec. - Global Arguments my_fun x : rename. - End My_Sec. - -The `Global Arguments` declaration succeeds fine, but the `End My_Sec` fails, with `Anomaly: dirpath_prefix: empty dirpath. Please report.` - -If `Global` is removed, or if no arguments are renamed, then everything works as expected. - -If other declarations go between the `Global Arguments` and the `End My_Sec`, then the other declarations work normally, but the `End My_Sec` still fails. - -Previously reported at https://github.com/HoTT/coq/issues/24 . Occurs in both 8.4 and current trunk. *) diff --git a/test-suite/bugs/closed/3003.v b/test-suite/bugs/closed/3003.v deleted file mode 100644 index 2f8bcdae7a..0000000000 --- a/test-suite/bugs/closed/3003.v +++ /dev/null @@ -1,12 +0,0 @@ -(* This used to raise an anomaly in 8.4 and trunk up to 17 April 2013 *) - -Set Implicit Arguments. - -Inductive path (V : Type) (E : V -> V -> Type) (s : V) : V -> Type := - | NoEdges : path E s s - | AddEdge : forall d d' : V, path E s d -> E d d' -> path E s d'. -Inductive G_Vertex := G_v0 | G_v1. -Inductive G_Edge : G_Vertex -> G_Vertex -> Set := G_e : G_Edge G_v0 G_v1. -Goal forall x1 : G_Edge G_v1 G_v1, @AddEdge _ G_Edge G_v1 _ _ (NoEdges _ _) x1 = NoEdges _ _. -intro x1. -try destruct x1. (* now raises a typing error *) diff --git a/test-suite/bugs/closed/3004.v b/test-suite/bugs/closed/3004.v deleted file mode 100644 index 896b1958b0..0000000000 --- a/test-suite/bugs/closed/3004.v +++ /dev/null @@ -1,7 +0,0 @@ -Set Implicit Arguments. -Unset Strict Implicit. -Parameter (M : nat -> Type). -Parameter (mp : forall (T1 T2 : Type) (f : T1 -> T2), list T1 -> list T2). - -Definition foo (s : list {n : nat & M n}) := - let exT := existT in mp (fun x => projT1 x) s. diff --git a/test-suite/bugs/closed/3008.v b/test-suite/bugs/closed/3008.v deleted file mode 100644 index 1979eda820..0000000000 --- a/test-suite/bugs/closed/3008.v +++ /dev/null @@ -1,29 +0,0 @@ -Module Type Intf1. -Parameter T : Type. -Inductive a := A. -End Intf1. - -Module Impl1 <: Intf1. -Definition T := unit. -Inductive a := A. -End Impl1. - -Module Type Intf2 - (Impl1 : Intf1). -Parameter x : Impl1.A=Impl1.A -> Impl1.T. -End Intf2. - -Module Type Intf3 - (Impl1 : Intf1) - (Impl2 : Intf2(Impl1)). -End Intf3. - -Fail Module Toto - (Impl1' : Intf1) - (Impl2 : Intf2(Impl1')) - (Impl3 : Intf3(Impl1)(Impl2)). -(* A UserError is expected here, not an uncaught Not_found *) - -(* NB : the Inductive above and the A=A weren't in the initial test, - they are here only to force an access to the environment - (cf [Printer.qualid_of_global]) and check that this env is ok. *) diff --git a/test-suite/bugs/closed/3010b.v b/test-suite/bugs/closed/3010b.v deleted file mode 100644 index 65fea42489..0000000000 --- a/test-suite/bugs/closed/3010b.v +++ /dev/null @@ -1,5 +0,0 @@ -Definition wtf (n : nat) : nat := - (match n with - 0 => (fun H : n = 0 => 0) - | S n' => (fun H : n = S n' => 0) - end) (eq_refl n). diff --git a/test-suite/bugs/closed/3016.v b/test-suite/bugs/closed/3016.v deleted file mode 100644 index bd4f1dd805..0000000000 --- a/test-suite/bugs/closed/3016.v +++ /dev/null @@ -1,4 +0,0 @@ -Section foo. - Variable C : Type. - Goal True. - change (eq (A := ?C) ?x ?y) with (eq). diff --git a/test-suite/bugs/closed/3017.v b/test-suite/bugs/closed/3017.v deleted file mode 100644 index 63a06bd3d6..0000000000 --- a/test-suite/bugs/closed/3017.v +++ /dev/null @@ -1,6 +0,0 @@ -Class A := {}. - Class B {T} `(A) := { B_intro : forall t t' : T, t = t' }. - Lemma foo T (t t' : T) : t = t'. - erewrite @B_intro. - reflexivity. - Abort. diff --git a/test-suite/bugs/closed/3022.v b/test-suite/bugs/closed/3022.v deleted file mode 100644 index dcfe733974..0000000000 --- a/test-suite/bugs/closed/3022.v +++ /dev/null @@ -1,8 +0,0 @@ -Goal forall (O obj : Type) (f : O -> obj) (x : O) (e : x = x) - (T : obj -> obj -> Type) (m : forall x0 : obj, T x0 x0), - match eq_sym e in (_ = y) return (T (f y) (f x)) with - | eq_refl => m (f x) - end = m (f x). -intros. -try case e. -Abort. diff --git a/test-suite/bugs/closed/3023.v b/test-suite/bugs/closed/3023.v deleted file mode 100644 index 70a1491e15..0000000000 --- a/test-suite/bugs/closed/3023.v +++ /dev/null @@ -1,33 +0,0 @@ -Set Implicit Arguments. -Generalizable All Variables. - -Record Category {obj : Type} := - { - Morphism : obj -> obj -> Type; - - Identity : forall x, Morphism x x; - Compose : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d'; - LeftIdentity : forall a b (f : Morphism a b), Compose (Identity b) f = f - }. - - -Section DiscreteAdjoints. - - Let C := {| - Morphism := (fun X Y : Type => X -> Y); - Identity := (fun X : Type => (fun x : X => x)); - Compose := (fun _ _ _ f g => (fun x => f (g x))); - LeftIdentity := (fun X Y p => @eq_refl _ p : (fun x : X => p x) = p) - |}. - Variable ObjectFunctor : C = C. - - Goal True. - Proof. - subst C. - revert ObjectFunctor. - intro ObjectFunctor. - simpl in ObjectFunctor. - revert ObjectFunctor. - Abort. - -End DiscreteAdjoints. diff --git a/test-suite/bugs/closed/3036.v b/test-suite/bugs/closed/3036.v deleted file mode 100644 index 3b57310d6e..0000000000 --- a/test-suite/bugs/closed/3036.v +++ /dev/null @@ -1,169 +0,0 @@ -(* Checking use of retyping in w_unify0 in the presence of unification -problems of the form \x:Meta.Meta = \x:ind.match x with ... end *) - -Require Import List. -Require Import QArith. -Require Import Qcanon. - -Set Implicit Arguments. - -Inductive dynamic : Type := - | Dyn : forall T, T -> dynamic. - -Definition perm := Qc. - -Locate Qle_bool. - -Definition compatibleb (p1 p2 : perm) : bool := -let p1pos := Qle_bool 0 p1 in - let p2pos := Qle_bool 0 p2 in - negb ( - (p1pos && p2pos) - || ((p1pos || p2pos) && (negb (Qle_bool 0 ((p1 + p2)%Qc)))))%Qc. - -Definition compatible (p1 p2 : perm) := compatibleb p1 p2 = true. - -Definition perm_plus (p1 p2 : perm) : option perm := - if compatibleb p1 p2 then Some (p1 + p2) else None. - -Infix "+p" := perm_plus (at level 60, no associativity). - -Axiom axiom_ptr : Set. - -Definition ptr := axiom_ptr. - -Axiom axiom_ptr_eq_dec : forall (a b : ptr), {a = b} + {a <> b}. - -Definition ptr_eq_dec := axiom_ptr_eq_dec. - -Definition hval := (dynamic * perm)%type. - -Definition heap := ptr -> option hval. - -Bind Scope heap_scope with heap. -Delimit Scope heap_scope with heap. -Local Open Scope heap_scope. - -Definition read (h : heap) (p : ptr) : option hval := h p. - -Notation "a # b" := (read a b) (at level 55, no associativity) : heap_scope. - -Definition val (v:hval) := fst v. -Definition frac (v:hval) := snd v. - -Definition hval_plus (v1 v2 : hval) : option hval := - match (frac v1) +p (frac v2) with - | None => None - | Some v1v2 => Some (val v1, v1v2) - end. - -Definition hvalo_plus (v1 v2 : option hval) := - match v1 with - | None => v2 - | Some v1' => - match v2 with - | None => v1 - | Some v2' => (hval_plus v1' v2') - end - end. - -Notation "v1 +o v2" := (hvalo_plus v1 v2) (at level 60, no associativity) : heap_scope. - -Definition join (h1 h2 : heap) : heap := - (fun p => (h1 p) +o (h2 p)). - -Infix "*" := join (at level 40, left associativity) : heap_scope. - -Definition hprop := heap -> Prop. - -Bind Scope hprop_scope with hprop. -Delimit Scope hprop_scope with hprop. - -Definition hprop_cell (p : ptr) T (v : T) (pi:Qc): hprop := fun h => - h#p = Some (Dyn v, pi) /\ forall p', p' <> p -> h#p' = None. - -Notation "p ---> v" := (hprop_cell p v (0%Qc)) (at level 38, no associativity) : hprop_scope. - -Definition empty : heap := fun _ => None. - -Definition hprop_empty : hprop := eq empty. -Notation "'emp'" := hprop_empty : hprop_scope. - -Definition hprop_inj (P : Prop) : hprop := fun h => h = empty /\ P. -Notation "[ P ]" := (hprop_inj P) (at level 0, P at level 200) : hprop_scope. - -Definition hprop_imp (p1 p2 : hprop) : Prop := forall h, p1 h -> p2 h. -Infix "==>" := hprop_imp (right associativity, at level 55). - -Definition hprop_ex T (p : T -> hprop) : hprop := fun h => exists v, p v h. -Notation "'Exists' v :@ T , p" := (hprop_ex (fun v : T => p%hprop)) - (at level 90, T at next level) : hprop_scope. - -Local Open Scope hprop_scope. -Definition disjoint (h1 h2 : heap) : Prop := - forall p, - match h1#p with - | None => True - | Some v1 => match h2#p with - | None => True - | Some v2 => val v1 = val v2 - /\ compatible (frac v1) (frac v2) - end - end. - -Infix "<#>" := disjoint (at level 40, no associativity) : heap_scope. - -Definition split (h h1 h2 : heap) : Prop := h1 <#> h2 /\ h = h1 * h2. - -Notation "h ~> h1 * h2" := (split h h1 h2) (at level 40, h1 at next level, no associativity). - -Definition hprop_sep (p1 p2 : hprop) : hprop := fun h => - exists h1, exists h2, h ~> h1 * h2 - /\ p1 h1 - /\ p2 h2. -Infix "*" := hprop_sep (at level 40, left associativity) : hprop_scope. - -Section Stack. - Variable T : Set. - - Record node : Set := Node { - data : T; - next : option ptr - }. - - Fixpoint listRep (ls : list T) (hd : option ptr) {struct ls} : hprop := - match ls with - | nil => [hd = None] - | h :: t => - match hd with - | None => [False] - | Some hd' => Exists p :@ option ptr, hd' ---> Node h p * listRep t p - end - end%hprop. - - Definition stack := ptr. - - Definition rep q ls := (Exists po :@ option ptr, q ---> po * listRep ls po)%hprop. - - Definition isExistential T (x : T) := True. - - Theorem himp_ex_conc_trivial : forall T p p1 p2, - p ==> p1 * p2 - -> T - -> p ==> hprop_ex (fun _ : T => p1) * p2. - Admitted. - - Goal forall (s : ptr) (x : T) (nd : ptr) (v : unit) (x0 : list T) (v0 : option ptr) - (H0 : isExistential v0), - nd ---> {| data := x; next := v0 |} * (s ---> Some nd * listRep x0 v0) ==> - (Exists po :@ option ptr, - s ---> po * - match po with - | Some hd' => - Exists p :@ option ptr, - hd' ---> {| data := x; next := p |} * listRep x0 p - | None => [False] - end) * emp. - Proof. - intros. - try apply himp_ex_conc_trivial. diff --git a/test-suite/bugs/closed/3037.v b/test-suite/bugs/closed/3037.v deleted file mode 100644 index baa7eff549..0000000000 --- a/test-suite/bugs/closed/3037.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Anomaly before 4a8950ec7a0d9f2b216e67e69b446c064590a8e9 *) - -Require Import Recdef. - -Function f_R (a: nat) {wf (fun x y: nat => False) a}:Prop:= - match a:nat with - | 0 => True - | (S y') => f_R y' - end. -(* Anomaly: File "plugins/funind/recdef.ml", line 916, characters 13-19: Assertion failed. -Please report. *) diff --git a/test-suite/bugs/closed/3043.v b/test-suite/bugs/closed/3043.v deleted file mode 100644 index 654663b4fc..0000000000 --- a/test-suite/bugs/closed/3043.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal (fun A (P : A -> Prop) (X : sigT P) => proj1_sig (sig_of_sigT X)) = - (fun A (P : A -> Prop) (X : sigT P) => projT1 X). - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/3045.v b/test-suite/bugs/closed/3045.v deleted file mode 100644 index 5f80013df2..0000000000 --- a/test-suite/bugs/closed/3045.v +++ /dev/null @@ -1,34 +0,0 @@ - -Set Asymmetric Patterns. -Generalizable All Variables. -Set Implicit Arguments. -Set Universe Polymorphism. - -Record SpecializedCategory (obj : Type) := - { - Object :> _ := obj; - Morphism : obj -> obj -> Type; - - Compose : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' - }. - -Arguments Compose {obj} [C s d d'] _ _ : rename. - -Inductive ReifiedMorphism : forall objC (C : SpecializedCategory objC), C -> C -> Type := -| ReifiedComposedMorphism : forall objC C s d d', ReifiedMorphism C d d' -> ReifiedMorphism C s d -> @ReifiedMorphism objC C s d'. - -Fixpoint ReifiedMorphismDenote objC C s d (m : @ReifiedMorphism objC C s d) : Morphism C s d := - match m in @ReifiedMorphism objC C s d return Morphism C s d with - | ReifiedComposedMorphism _ _ _ _ _ m1 m2 => Compose (@ReifiedMorphismDenote _ _ _ _ m1) - (@ReifiedMorphismDenote _ _ _ _ m2) - end. - -Fixpoint ReifiedMorphismSimplifyWithProof objC C s d (m : @ReifiedMorphism objC C s d) -: { m' : ReifiedMorphism C s d | ReifiedMorphismDenote m = ReifiedMorphismDenote m' }. -refine match m with - | ReifiedComposedMorphism _ _ s0 d0 d0' m1 m2 => _ - end; clear m. -(* This fails with an error rather than an anomaly, but morally - it should work, if destruct were able to do the good generalization - in advance, before doing the "intros []". *) -Fail destruct (@ReifiedMorphismSimplifyWithProof T s1 d0 d0' m1) as [ [] ? ]. diff --git a/test-suite/bugs/closed/3050.v b/test-suite/bugs/closed/3050.v deleted file mode 100644 index 4b18722431..0000000000 --- a/test-suite/bugs/closed/3050.v +++ /dev/null @@ -1,7 +0,0 @@ -Goal forall A B, A * B -> A. -Proof. -intros A B H. -match goal with - | [ H : _ * _ |- _ ] => exact (fst H) -end. -Qed. diff --git a/test-suite/bugs/closed/3054.v b/test-suite/bugs/closed/3054.v deleted file mode 100644 index 936e58e197..0000000000 --- a/test-suite/bugs/closed/3054.v +++ /dev/null @@ -1,10 +0,0 @@ -Section S. - -Let V := Type. - -Goal ~ true = false. -Proof. -congruence. -Qed. - -End S. diff --git a/test-suite/bugs/closed/3062.v b/test-suite/bugs/closed/3062.v deleted file mode 100644 index a7b5fab03e..0000000000 --- a/test-suite/bugs/closed/3062.v +++ /dev/null @@ -1,5 +0,0 @@ -Lemma foo : forall x y:nat, x < y -> False. -Proof. - intros x y H. - induction H as [ |?y ?y ?y]. -Abort. diff --git a/test-suite/bugs/closed/3068.v b/test-suite/bugs/closed/3068.v deleted file mode 100644 index 9811733dc6..0000000000 --- a/test-suite/bugs/closed/3068.v +++ /dev/null @@ -1,64 +0,0 @@ -Require Import TestSuite.admit. -Section Counted_list. - - Variable A : Type. - - Inductive counted_list : nat -> Type := - | counted_nil : counted_list 0 - | counted_cons : forall(n : nat), - A -> counted_list n -> counted_list (S n). - - - Fixpoint counted_def_nth{n : nat}(l : counted_list n) - (i : nat)(def : A) : A := - match i with - | 0 => match l with - | counted_nil => def - | counted_cons _ a _ => a - end - | S i => match l with - | counted_nil => def - | counted_cons _ _ tl => counted_def_nth tl i def - end - end. - - - Lemma counted_list_equal_nth_char : - forall(n : nat)(l1 l2 : counted_list n)(def : A), - (forall(i : nat), counted_def_nth l1 i def = counted_def_nth l2 i def) -> - l1 = l2. - Proof. - admit. - Qed. - -End Counted_list. - -Arguments counted_def_nth [A n]. - -Section Finite_nat_set. - - Variable set_size : nat. - - Definition fnat_subset : Type := counted_list bool set_size. - - Definition fnat_member(fs : fnat_subset)(n : nat) : Prop := - is_true (counted_def_nth fs n false). - - - Lemma fnat_subset_member_eq : forall(fs1 fs2 : fnat_subset), - fs1 = fs2 <-> - forall(n : nat), fnat_member fs1 n <-> fnat_member fs2 n. - - Proof. - intros fs1 fs2. - split. - intros H n. - subst fs1. - apply iff_refl. - intros H. - eapply (counted_list_equal_nth_char _ _ _ _ ?[def]). - intros i. - destruct (counted_def_nth fs1 i _ ) eqn:H0. - (* This was not part of the initial bug report; this is to check that - the existential variable kept its name *) - change (true = counted_def_nth fs2 i ?def). diff --git a/test-suite/bugs/closed/3070.v b/test-suite/bugs/closed/3070.v deleted file mode 100644 index 7a8feca587..0000000000 --- a/test-suite/bugs/closed/3070.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Testing subst wrt chains of dependencies *) - -Lemma foo (a1 a2 : Set) (b1 : a1 -> Prop) - (Ha : a1 = a2) (c : a1) (d : b1 c) : True. -Proof. - subst. diff --git a/test-suite/bugs/closed/3071.v b/test-suite/bugs/closed/3071.v deleted file mode 100644 index 53c2ef7b71..0000000000 --- a/test-suite/bugs/closed/3071.v +++ /dev/null @@ -1,5 +0,0 @@ -Definition foo := True. - -Section foo. - Global Arguments foo / . -End foo. diff --git a/test-suite/bugs/closed/3080.v b/test-suite/bugs/closed/3080.v deleted file mode 100644 index 36ab7ff599..0000000000 --- a/test-suite/bugs/closed/3080.v +++ /dev/null @@ -1,18 +0,0 @@ -(* -*- coq-prog-args: ("-nois") -*- *) -Delimit Scope type_scope with type. -Delimit Scope function_scope with function. - -Bind Scope type_scope with Sortclass. -Bind Scope function_scope with Funclass. - -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Notation "A -> B" := (forall (_ : A), B) : type_scope. - -Definition compose {A B C} (g : B -> C) (f : A -> B) := - fun x : A => g (f x). - -Notation " g ∘ f " := (compose g f) - (at level 40, left associativity) : function_scope. - -Fail Check (fun x => x) ∘ (fun x => x). (* this [Check] should fail, as [function_scope] is not opened *) -Check compose ((fun x => x) ∘ (fun x => x)) (fun x => x). (* this check should succeed, as [function_scope] should be automatically bound in the arugments to [compose] *) diff --git a/test-suite/bugs/closed/3088.v b/test-suite/bugs/closed/3088.v deleted file mode 100644 index 3c362510e3..0000000000 --- a/test-suite/bugs/closed/3088.v +++ /dev/null @@ -1,12 +0,0 @@ -Inductive R {A} : A -> A -> Type := c : forall x y, R x y. - -Goal forall A (x y : A) P (e : R x y) (f : forall x y, P x y (c x y)), - let g := match e in R x y return P x y e with c x y => f x y end in - True. -Proof. -intros A x y P e f g. -let t := eval red in g in -match t with - (match ?E as e in R x y return @?P x y e with c X Y => @?f X Y end) => idtac P f -end. -Abort. diff --git a/test-suite/bugs/closed/3093.v b/test-suite/bugs/closed/3093.v deleted file mode 100644 index f6b4a03f3b..0000000000 --- a/test-suite/bugs/closed/3093.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import FunctionalExtensionality. - -Goal forall y, @f_equal = y. - intro. - apply functional_extensionality_dep. -Abort. diff --git a/test-suite/bugs/closed/3100.v b/test-suite/bugs/closed/3100.v deleted file mode 100644 index 6f35a74dc1..0000000000 --- a/test-suite/bugs/closed/3100.v +++ /dev/null @@ -1,9 +0,0 @@ -Fixpoint F (n : nat) (A : Type) : Type := - match n with - | 0 => True - | S n => forall (x : A), F n (x = x) - end. - -Goal forall A n, (forall (x : A) (e : x = x), F n (e = e)). -intros A n. -Fail change (forall x, F n (x = x)) with (F (S n)). diff --git a/test-suite/bugs/closed/3125.v b/test-suite/bugs/closed/3125.v deleted file mode 100644 index 797146174d..0000000000 --- a/test-suite/bugs/closed/3125.v +++ /dev/null @@ -1,27 +0,0 @@ -(* Not considering singleton template-polymorphic inductive types as - propositions for injection/inversion *) - -(* This is also #4560 and #6273 *) - -Inductive foo := foo_1. - -Goal forall (a b : foo), Some a = Some b -> a = b. -Proof. - intros a b H. - inversion H. - reflexivity. -Qed. - -(* Check that Prop is not concerned *) - -Inductive bar : Prop := bar_1. - -Goal - forall (a b : bar), - Some a = Some b -> - a = b. -Proof. - intros a b H. - inversion H. - Fail reflexivity. -Abort. diff --git a/test-suite/bugs/closed/3142.v b/test-suite/bugs/closed/3142.v deleted file mode 100644 index 988074e2f1..0000000000 --- a/test-suite/bugs/closed/3142.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Fixed together with #3262 in 48af6d1418282323b9fff0e789fed9478c064434 *) -(* April 4, 2014 (non-progress in candidates was not detected) *) - -Definition eqbool_dep (P : bool -> Prop) (h1 : P true) (b : bool) (h2 : P b) - : Prop := -(match b (* return P b -> Prop *) with - | true => fun (h : P true) => h1 = h - | false => fun (_ : P false) => False -end (* : P b -> Prop *)) h2. diff --git a/test-suite/bugs/closed/3164.v b/test-suite/bugs/closed/3164.v deleted file mode 100644 index 3c9af8d0f3..0000000000 --- a/test-suite/bugs/closed/3164.v +++ /dev/null @@ -1,49 +0,0 @@ -(* Before 31a69c4d0fd7b8325187e8da697a9c283594047d, [case] would stack overflow *) -Require Import Arith. - -Section Acc_generator. - Variable A : Type. - Variable R : A -> A -> Prop. - - (* *Lazily* add 2^n - 1 Acc_intro on top of wf. - Needed for fast reductions using Function and Program Fixpoint - and probably using Fix and Fix_F_2 - *) - Fixpoint Acc_intro_generator n (wf : well_founded R) := - match n with - | O => wf - | S n => fun x => Acc_intro x (fun y _ => Acc_intro_generator n (Acc_intro_generator n wf) y) - end. - - -End Acc_generator. - -Definition pred_F : (forall x : nat, - (forall y : nat, y < x -> (fun _ : nat => nat) y) -> - (fun _ : nat => nat) x). -Proof. - intros x. - simpl. - case x. - exact (fun _ => 0). - intros n h. - apply (h n). - constructor. -Defined. - -Definition my_pred := Fix lt_wf (fun _ => nat) pred_F. - - -Lemma my_pred_is_pred : forall x, match my_pred x with | 0 => True | S n => False end. -Proof. - intros x. - case x. -Abort. - -Definition my_pred_bad := Fix (Acc_intro_generator _ _ 100 lt_wf) (fun _ => nat) pred_F. - -Lemma my_pred_is_pred : forall x, match my_pred_bad x with | 0 => True | S n => False end. -Proof. - intros x. - Timeout 2 case x. -Admitted. diff --git a/test-suite/bugs/closed/3188.v b/test-suite/bugs/closed/3188.v deleted file mode 100644 index 0117602670..0000000000 --- a/test-suite/bugs/closed/3188.v +++ /dev/null @@ -1,22 +0,0 @@ -(* File reduced by coq-bug-finder from 1656 lines to 221 lines to 26 lines to 7 lines. *) - -Module Long. - Require Import Coq.Classes.RelationClasses. - - Hint Extern 0 => apply reflexivity : typeclass_instances. - Hint Extern 1 => symmetry. - - Lemma foo : exists m' : Type, True. - intuition. (* Anomaly: Uncaught exception Not_found. Please report. *) - Abort. -End Long. - -Module Short. - Require Import Coq.Classes.RelationClasses. - - Hint Extern 0 => apply reflexivity : typeclass_instances. - - Lemma foo : exists m' : Type, True. - try symmetry. (* Anomaly: Uncaught exception Not_found. Please report. *) - Abort. -End Short. diff --git a/test-suite/bugs/closed/3199.v b/test-suite/bugs/closed/3199.v deleted file mode 100644 index 08bf62493d..0000000000 --- a/test-suite/bugs/closed/3199.v +++ /dev/null @@ -1,18 +0,0 @@ -Axiom P : nat -> Prop. -Axiom admit : forall n : nat, P n -> P n -> n = S n. -Axiom foo : forall n, P n. - -Create HintDb bar. -Hint Extern 3 => symmetry : bar. -Hint Resolve admit : bar. -Hint Immediate foo : bar. - -Lemma qux : forall n : nat, n = S n. -Proof. -intros n. -eauto with bar. -Defined. - -Goal True. -pose (e := eq_refl (qux 0)); unfold qux in e. -match type of e with context [eq_sym] => fail 1 | _ => idtac end. diff --git a/test-suite/bugs/closed/3205.v b/test-suite/bugs/closed/3205.v deleted file mode 100644 index 5c44f07036..0000000000 --- a/test-suite/bugs/closed/3205.v +++ /dev/null @@ -1,26 +0,0 @@ -Fail Fixpoint F (u : unit) : Prop := - (fun p : {P : Prop & _} => match p with existT _ _ P => P end) - (existT (fun P => False -> P) (F tt) _). -(* Anomaly: A universe comparison can only happen between variables. -Please report. *) - - - -Definition g (x : Prop) := x. - -Definition h (y : Type) := y. - -Definition eq_hf : h = g :> (Prop -> Type) := - @eq_refl (Prop -> Type) g. - -Set Printing All. -Set Printing Universes. -Fail Definition eq_hf : h = g :> (Prop -> Type) := - eq_refl g. -(* Originally an anomaly, now says -Toplevel input, characters 48-57: -Error: -The term "@eq_refl (forall _ : Prop, Prop) g" has type - "@eq (forall _ : Prop, Prop) g g" while it is expected to have type - "@eq (forall _ : Prop, Type (* Top.16 *)) (fun y : Prop => h y) g" -(Universe inconsistency: Cannot enforce Prop = Top.16)). *) diff --git a/test-suite/bugs/closed/3209.v b/test-suite/bugs/closed/3209.v deleted file mode 100644 index 855058b011..0000000000 --- a/test-suite/bugs/closed/3209.v +++ /dev/null @@ -1,75 +0,0 @@ -(* Avoiding some occur-check *) - -(* 1. Original example *) - -Inductive eqT {A} (x : A) : A -> Type := - reflT : eqT x x. -Definition Bi_inv (A B : Type) (f : (A -> B)) := - sigT (fun (g : B -> A) => - sigT (fun (h : B -> A) => - sigT (fun (α : forall b : B, eqT (f (g b)) b) => - forall a : A, eqT (h (f a)) a))). -Definition TEquiv (A B : Type) := sigT (fun (f : A -> B) => Bi_inv _ _ f). - -Axiom UA : forall (A B : Type), TEquiv (TEquiv A B) (eqT A B). -Definition idtoeqv {A B} (e : eqT A B) : TEquiv A B := - sigT_rect (fun _ => TEquiv A B) - (fun (f : TEquiv A B -> eqT A B) H => - sigT_rect _ (* (fun _ => TEquiv A B) *) - (fun g _ => g e) - H) - (UA A B). - -(* 2. Alternative example by Guillaume *) - -Inductive foo (A : Prop) : Prop := Foo : foo A. -Axiom bar : forall (A : Prop) (P : foo A -> Prop), (A -> P (Foo A)) -> Prop. - -(* This used to fail with a Not_found, we fail more graciously but a - heuristic could be implemented, e.g. in some smart occur-check - function, to find a solution of then form ?P := fun _ => ?P' *) - -Fail Check (fun e : ?[T] => bar ?[A] ?[P] (fun g : ?[A'] => g e)). - -(* This works and tells which solution we could have inferred *) - -Check (fun e : ?[T] => bar ?[A] (fun _ => ?[P]) (fun g : ?[A'] => g e)). - -(* For the record, here is the trace in the failing example: - -In (fun e : ?T => bar ?[A] ?[P] (fun g : ?A' => g e)), we have the existential variables - -e:?T |- ?A : Prop -e:?T |- ?P : foo ?A -> Prop -e:?T |- ?A' : Type - -with constraints - -?A' == ?A -?A' == ?T -> ?P (Foo ?A) - -To type (g e), unification first defines - -?A := forall x:?B, ?P'{e:=e,x:=x} -with ?T <= ?B -and ?P'@{e:=e,x:=e} <= ?P@{e:=e} (Foo (forall x:?B, ?P'{e:=e,x:=x})) - -Then, since ?P'@{e:=e,x:=e} may use "e" in two different ways, it is -not a pattern and we define a new - -e:?T x:?B|- ?P'' : foo (?B' -> ?P''') -> Prop - -for some ?B' and ?P''', together with - -?P'@{e,x} := ?P''{e:=e,x:=e} (Foo (?B -> ?P') -?P@{e} := ?P''{e:=e,x:=e} - -Moreover, ?B' and ?P''' have to satisfy - -?B'@{e:=e,x:=e} == ?B@{e:=e} -?P'''@{e:=e,x:=e} == ?P'@{e:=e,x:=x} - -and this leads to define ?P' which was the initial existential -variable to define. -*) - diff --git a/test-suite/bugs/closed/3210.v b/test-suite/bugs/closed/3210.v deleted file mode 100644 index bb673f38c2..0000000000 --- a/test-suite/bugs/closed/3210.v +++ /dev/null @@ -1,22 +0,0 @@ -(* Test support of let-in in arity of inductive types *) - -Inductive Foo : let X := Set in X := -| I : Foo. - -Definition foo (x : Foo) : bool := - match x with - I => true - end. - -Definition foo' (x : Foo) : x = x. -case x. -match goal with |- I = I => idtac end. (* check form of the goal *) -Undo 2. -elim x. -match goal with |- I = I => idtac end. (* check form of the goal *) -Undo 2. -induction x. -match goal with |- I = I => idtac end. (* check form of the goal *) -Undo 2. -destruct x. -match goal with |- I = I => idtac end. (* check form of the goal *) diff --git a/test-suite/bugs/closed/3212.v b/test-suite/bugs/closed/3212.v deleted file mode 100644 index 53d8dfe326..0000000000 --- a/test-suite/bugs/closed/3212.v +++ /dev/null @@ -1,10 +0,0 @@ -Lemma H : Prop = Prop. -reflexivity. -Qed. - -Lemma foo : match H in (_ = X) return X with - | eq_refl => True -end. -Proof. -Fail destruct H. -Abort. diff --git a/test-suite/bugs/closed/3217.v b/test-suite/bugs/closed/3217.v deleted file mode 100644 index ec846bf95b..0000000000 --- a/test-suite/bugs/closed/3217.v +++ /dev/null @@ -1,36 +0,0 @@ -(** [Set Implicit Arguments] causes Coq to run out of memory on [Qed] before c3feef4ed5dec126f1144dec91eee9c0f0522a94 *) -Set Implicit Arguments. - -Variable LEM: forall P : Prop, sumbool P (P -> False). - -Definition pmap := option (nat -> option nat). - -Definition pmplus (oha ohb: pmap) : pmap := - match oha, ohb with - | Some ha, Some hb => - if LEM (oha = ohb) then None else None - | _, _ => None - end. - -Definition pmemp: pmap := Some (fun _ => None). - -Lemma foo: - True -> - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - (pmplus pmemp - pmemp)))))))))))) - = - None -> True. -Proof. - auto. -Timeout 2 Qed. diff --git a/test-suite/bugs/closed/3228.v b/test-suite/bugs/closed/3228.v deleted file mode 100644 index 5d1a0ff88b..0000000000 --- a/test-suite/bugs/closed/3228.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Check that variables in the context do not take precedence over - ltac variables *) - -Ltac bar x := exact x. -Goal False -> False. - intro x. - Fail bar doesnotexist. diff --git a/test-suite/bugs/closed/3230.v b/test-suite/bugs/closed/3230.v deleted file mode 100644 index 265310b1a3..0000000000 --- a/test-suite/bugs/closed/3230.v +++ /dev/null @@ -1,14 +0,0 @@ -Structure type : Type := Pack { ob : Type }. -Polymorphic Record category := { foo : Type }. -Definition FuncComp := Pack category. -Axiom C : category. - -Check (C : ob FuncComp). (* OK *) - -Canonical Structure FuncComp. - -Check (C : ob FuncComp). -(* Toplevel input, characters 15-39: -Error: -The term "C" has type "category" while it is expected to have type - "ob FuncComp". *) diff --git a/test-suite/bugs/closed/3242.v b/test-suite/bugs/closed/3242.v deleted file mode 100644 index 805baee153..0000000000 --- a/test-suite/bugs/closed/3242.v +++ /dev/null @@ -1,2 +0,0 @@ -Inductive Foo (x := Type) := C : Foo -> Foo. - diff --git a/test-suite/bugs/closed/3249.v b/test-suite/bugs/closed/3249.v deleted file mode 100644 index 71d457b002..0000000000 --- a/test-suite/bugs/closed/3249.v +++ /dev/null @@ -1,11 +0,0 @@ -Set Implicit Arguments. - -Ltac ret_and_left T := - let t := type of T in - lazymatch eval hnf in t with - | ?a /\ ?b => constr:(proj1 T) - | forall x : ?T', @?f x => - constr:(fun x : T' => ltac:(let fx := constr:(T x) in - let t := ret_and_left fx in - exact t)) - end. diff --git a/test-suite/bugs/closed/3251.v b/test-suite/bugs/closed/3251.v deleted file mode 100644 index d4ce050c57..0000000000 --- a/test-suite/bugs/closed/3251.v +++ /dev/null @@ -1,14 +0,0 @@ -Goal True. -idtac. -Ltac foo := idtac. -(* print out happens twice: -foo is defined -foo is defined - -... that's fishy. But E. Tassi tells me that it's expected since "Ltac" generates a side -effect that escapes the proof. In the STM model this means the command is executed twice, -once in the proof branch, and another time in the main branch *) -Undo. -Ltac foo := idtac. -(* Before 5b39c3535f7b3383d89d7b844537244a4e7c0eca, this would print out: *) -(* Anomaly: Backtrack.backto to a state with no vcs_backup. Please report. *) diff --git a/test-suite/bugs/closed/3257.v b/test-suite/bugs/closed/3257.v deleted file mode 100644 index d8aa6a0479..0000000000 --- a/test-suite/bugs/closed/3257.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Import Setoid Morphisms Basics. -Lemma foo A B (P : B -> Prop) : - pointwise_relation _ impl (fun z => A -> P z) P. -Proof. - Fail reflexivity. diff --git a/test-suite/bugs/closed/3258.v b/test-suite/bugs/closed/3258.v deleted file mode 100644 index b263c6baf4..0000000000 --- a/test-suite/bugs/closed/3258.v +++ /dev/null @@ -1,36 +0,0 @@ -Require Import TestSuite.admit. -Require Import Coq.Classes.Morphisms Coq.Classes.RelationClasses Coq.Program.Program Coq.Setoids.Setoid. - -Global Set Implicit Arguments. - -Hint Extern 0 => apply reflexivity : typeclass_instances. - -Inductive Comp : Type -> Type := -| Pick : forall A, (A -> Prop) -> Comp A. - -Axiom computes_to : forall A, Comp A -> A -> Prop. - -Axiom refine : forall {A} (old : Comp A) (new : Comp A), Prop. - -Global Instance refine_PreOrder A : PreOrder (@refine A). -Admitted. -Add Parametric Morphism A -: (@Pick A) - with signature - (pointwise_relation _ (flip impl)) - ==> (@refine A) - as refine_flip_impl_Pick. - admit. -Defined. -Definition remove_forall_eq' A x B (P : A -> B -> Prop) : pointwise_relation _ impl (P x) (fun z => forall y : A, y = x -> P y z). - admit. -Defined. -Goal forall A B (x : A) (P : _ -> _ -> Prop), - refine (Pick (fun n : B => forall y, y = x -> P y n)) - (Pick (fun n : B => P x n)). -Proof. - intros. - setoid_rewrite (@remove_forall_eq' _ _ _ _). - Undo. - (* This failed with NotConvertible at some time *) - setoid_rewrite (@remove_forall_eq' _ _ _). diff --git a/test-suite/bugs/closed/3259.v b/test-suite/bugs/closed/3259.v deleted file mode 100644 index aa91fc3de7..0000000000 --- a/test-suite/bugs/closed/3259.v +++ /dev/null @@ -1,22 +0,0 @@ -Require Import TestSuite.admit. -Goal forall m n, n+n = m+m -> m+m = m+m. -Proof. -intros. -set (k := n+n) in *. -cut (n=m). -intro. -subst n. -admit. -admit. -Qed. - -Goal forall m n, n+n = m+m -> n+n = m+m. -Proof. -intros. -set (k := n+n). -cut (n=m). -intro. -subst n. -admit. -admit. -Qed. diff --git a/test-suite/bugs/closed/3260.v b/test-suite/bugs/closed/3260.v deleted file mode 100644 index 9f0231d91b..0000000000 --- a/test-suite/bugs/closed/3260.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Setoid. -Goal forall m n, n = m -> n+n = m+m. -intros. -replace n with m at 2. -lazymatch goal with -|- n + m = m + m => idtac -end. diff --git a/test-suite/bugs/closed/3262.v b/test-suite/bugs/closed/3262.v deleted file mode 100644 index 70bfde2990..0000000000 --- a/test-suite/bugs/closed/3262.v +++ /dev/null @@ -1,78 +0,0 @@ -(* Not having a [return] clause causes the [refine] at the bottom to stack overflow before f65fa9de8a4c9c12d933188a755b51508bd51921 *) - -Require Import Coq.Lists.List. -Require Import Relations RelationClasses. - -Set Implicit Arguments. -Set Strict Implicit. -Set Asymmetric Patterns. - -Section hlist. - Context {iT : Type}. - Variable F : iT -> Type. - - Inductive hlist : list iT -> Type := - | Hnil : hlist nil - | Hcons : forall l ls, F l -> hlist ls -> hlist (l :: ls). - - Definition hlist_hd {a b} (hl : hlist (a :: b)) : F a := - match hl in hlist x return match x with - | nil => unit - | l :: _ => F l - end with - | Hnil => tt - | Hcons _ _ x _ => x - end. - - Definition hlist_tl {a b} (hl : hlist (a :: b)) : hlist b := - match hl in hlist x return match x with - | nil => unit - | _ :: ls => hlist ls - end with - | Hnil => tt - | Hcons _ _ _ x => x - end. - - Lemma hlist_eta : forall ls (h : hlist ls), - h = match ls as ls return hlist ls -> hlist ls with - | nil => fun _ => Hnil - | a :: b => fun h => Hcons (hlist_hd h) (hlist_tl h) - end h. - Proof. - intros. destruct h; auto. - Qed. - - Variable eqv : forall x, relation (F x). - - Inductive equiv_hlist : forall ls, hlist ls -> hlist ls -> Prop := - | hlist_eqv_nil : equiv_hlist Hnil Hnil - | hlist_eqv_cons : forall l ls x y h1 h2, eqv x y -> equiv_hlist h1 h2 -> - @equiv_hlist (l :: ls) (Hcons x h1) (Hcons y h2). - - Global Instance Reflexive_equiv_hlist (R : forall t, Reflexive (@eqv t)) ls - : Reflexive (@equiv_hlist ls). - Proof. - red. induction x; constructor; auto. reflexivity. - Qed. - - Global Instance Transitive_equiv_hlist (R : forall t, Transitive (@eqv t)) ls - : Transitive (@equiv_hlist ls). - Proof. - red. induction 1. - { intro; assumption. } - { rewrite (hlist_eta z). - Timeout 2 Fail refine - (fun H => - match H in @equiv_hlist ls X Y - return - (* Uncommenting the following gives an immediate error in 8.4pl3; commented out results in a stack overflow *) - match ls (*as ls return hlist ls -> hlist ls -> Type*) with - | nil => fun _ _ : hlist nil => True - | l :: ls => fun (X Y : hlist (l :: ls)) => - equiv_hlist (Hcons x h1) Y - end X Y - with - | hlist_eqv_nil => I - | hlist_eqv_cons l ls x y h1 h2 pf pf' => - _ - end). diff --git a/test-suite/bugs/closed/3264.v b/test-suite/bugs/closed/3264.v deleted file mode 100644 index 4eb218906f..0000000000 --- a/test-suite/bugs/closed/3264.v +++ /dev/null @@ -1,45 +0,0 @@ -Module File1. - Module Export DirA. - Module A. - Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - - Arguments idpath {A a} , [A] a. - - Notation "x = y :> A" := (@paths A x y) : type_scope. - Notation "x = y" := (x = y :>_) : type_scope. - End A. - End DirA. -End File1. - -Module File2. - Module Export DirA. - Module B. - Import File1. - Export A. - Lemma foo : forall x y : Type, x = y -> y = x. - Proof. - intros x y H. - rewrite <- H. - constructor. - Qed. - End B. - End DirA. -End File2. - -Module File3. - Module Export DirA. - Module C. - Import File1. - Export A. - Lemma bar : forall x y : Type, x = y -> y = x. - Proof. - intros x y H. - rewrite <- H. - constructor. - Defined. - Definition bar' - := Eval cbv beta iota zeta delta [bar internal_paths_rew] in bar. - End C. - End DirA. -End File3. diff --git a/test-suite/bugs/closed/3265.v b/test-suite/bugs/closed/3265.v deleted file mode 100644 index 269c7b741e..0000000000 --- a/test-suite/bugs/closed/3265.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import Setoid. -Hint Extern 0 => apply reflexivity : typeclass_instances. -Goal forall (B : Type) (P : B -> Prop), exists y : B, P y. - intros. - try reflexivity. (* Anomaly: Uncaught exception Not_found. Please report. *) -Abort. diff --git a/test-suite/bugs/closed/3266.v b/test-suite/bugs/closed/3266.v deleted file mode 100644 index fd4cbff85c..0000000000 --- a/test-suite/bugs/closed/3266.v +++ /dev/null @@ -1,3 +0,0 @@ -Class A := a : nat. -Lemma p : True. -Proof. cut A; [tauto | exact 1]. Qed. diff --git a/test-suite/bugs/closed/3267.v b/test-suite/bugs/closed/3267.v deleted file mode 100644 index 8175d66ac7..0000000000 --- a/test-suite/bugs/closed/3267.v +++ /dev/null @@ -1,47 +0,0 @@ -Module a. - Local Hint Extern 0 => progress subst. - Goal forall T (x y : T) (P Q : _ -> Prop), x = y -> (P x -> Q x) -> P y -> Q y. - Proof. - intros. - (* this should not fail *) - progress eauto. - Defined. -End a. - -Module b. - Local Hint Extern 0 => progress subst. - Goal forall T (x y : T) (P Q : _ -> Prop), y = x -> (P x -> Q x) -> P y -> Q y. - Proof. - intros. - eauto. - Defined. -End b. - -Module c. - Local Hint Extern 0 => progress subst; eauto. - Goal forall T (x y : T) (P Q : _ -> Prop), x = y -> (P x -> Q x) -> P y -> Q y. - Proof. - intros. - eauto. - Defined. -End c. - -Module d. - Local Hint Extern 0 => progress subst; repeat match goal with H : _ |- _ => revert H end. - Goal forall T (x y : T) (P Q : _ -> Prop), x = y -> (P x -> Q x) -> P y -> Q y. - Proof. - intros. - debug eauto. - Defined. -End d. - -(* An other variant which was still failing in 8.5 beta2 *) - -Parameter A B : Prop. -Axiom a:B. - -Hint Extern 1 => match goal with H:_ -> id _ |- _ => try (unfold id in H) end. -Goal (B -> id A) -> A. -intros. -eauto using a. -Abort. diff --git a/test-suite/bugs/closed/3281.v b/test-suite/bugs/closed/3281.v deleted file mode 100644 index d340f0ca48..0000000000 --- a/test-suite/bugs/closed/3281.v +++ /dev/null @@ -1,5 +0,0 @@ -Fail Lemma foo : @eq _ nat Type. -Fail Lemma foo : @eq Set nat Type. - -Lemma foo : @eq Type nat Type. Admitted. -Lemma foo' : @eq _ Type nat. Admitted. diff --git a/test-suite/bugs/closed/3282.v b/test-suite/bugs/closed/3282.v deleted file mode 100644 index ce7cab1cba..0000000000 --- a/test-suite/bugs/closed/3282.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Check let-ins in fix and Fixpoint *) - -Definition foo := fix f (m : nat) (o := true) (n : nat) {struct n} := - match n with 0 => 0 | S n' => f 0 n' end. - -Fixpoint f (m : nat) (o := true) (n : nat) {struct n} := - match n with 0 => 0 | S n' => f 0 n' end. diff --git a/test-suite/bugs/closed/3284.v b/test-suite/bugs/closed/3284.v deleted file mode 100644 index 34cd09c6f4..0000000000 --- a/test-suite/bugs/closed/3284.v +++ /dev/null @@ -1,23 +0,0 @@ -(* Several bugs: -- wrong env in pose_all_metas_as_evars leading to out of scope instance of evar -- check that metas posed as evars in pose_all_metas_as_evars were - resolved was not done -*) - -Axiom functional_extensionality_dep : - forall {A : Type} {B : A -> Type} (f g : forall x : A, B x), - (forall x : A, f x = g x) -> f = g. - -Goal forall A B C (f g : forall (x : A) (y : B x), C x y), forall x:A, (forall x y, f x y = g x y) -> True. -Proof. - intros A B C f g x H. - Fail apply @functional_extensionality_dep in H. - Fail apply functional_extensionality_dep in H. - eapply functional_extensionality_dep in H. -Abort. - -Goal forall A B C (f g : forall (x : A) (y : B x), C x y), forall x:A, (forall x y, f x y = g x y) -> True. -Proof. - intros A B C f g x H. - specialize (H x). - apply functional_extensionality_dep in H. diff --git a/test-suite/bugs/closed/3285.v b/test-suite/bugs/closed/3285.v deleted file mode 100644 index 68e6b7386f..0000000000 --- a/test-suite/bugs/closed/3285.v +++ /dev/null @@ -1,7 +0,0 @@ -Goal True. -Proof. -match goal with - | _ => let x := constr:(ltac:(fail)) in idtac - | _ => idtac -end. -Abort. diff --git a/test-suite/bugs/closed/3286.v b/test-suite/bugs/closed/3286.v deleted file mode 100644 index 701480fc83..0000000000 --- a/test-suite/bugs/closed/3286.v +++ /dev/null @@ -1,41 +0,0 @@ -Require Import FunctionalExtensionality. - -Ltac make_apply_under_binders_in lem H := - let tac := make_apply_under_binders_in in - match type of H with - | forall x : ?T, @?P x - => let ret := constr:(fun x' : T => - let Hx := H x' in - ltac:(let ret' := tac lem Hx in - exact ret')) in - match eval cbv zeta in ret with - | fun x => Some (@?P x) => let P' := (eval cbv zeta in P) in - constr:(Some P') - end - | _ => let ret := constr:(ltac:(match goal with - | _ => (let H' := fresh in - pose H as H'; - apply lem in H'; - exact (Some H')) - | _ => exact (@None nat) - end - )) in - let ret' := (eval cbv beta zeta in ret) in - constr:(ret') - | _ => constr:(@None nat) - end. - -Ltac apply_under_binders_in lem H := - let H' := make_apply_under_binders_in lem H in - let H'0 := match H' with Some ?H'0 => constr:(H'0) end in - let H'' := fresh in - pose proof H'0 as H''; - clear H; - rename H'' into H. - -Goal forall A B C (f g : forall (x : A) (y : B x), C x y), (forall x y, f x y = g x y) -> True. -Proof. - intros A B C f g H. - let lem := constr:(@functional_extensionality_dep) in - apply_under_binders_in lem H. -(* Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/3287.v b/test-suite/bugs/closed/3287.v deleted file mode 100644 index 4b3e7ff054..0000000000 --- a/test-suite/bugs/closed/3287.v +++ /dev/null @@ -1,19 +0,0 @@ -Require Coq.extraction.Extraction. - -Module Foo. -(* Definition foo := (I,I). *) -Definition bar := true. -End Foo. - -Recursive Extraction Foo.bar. -Extraction TestCompile Foo.bar. - -Module Foo'. -Definition foo := (I,I). -Definition bar := true. -End Foo'. - -Recursive Extraction Foo'.bar. -Extraction TestCompile Foo'.bar. - -Extraction Foo'.bar. diff --git a/test-suite/bugs/closed/3289.v b/test-suite/bugs/closed/3289.v deleted file mode 100644 index 4542b015d0..0000000000 --- a/test-suite/bugs/closed/3289.v +++ /dev/null @@ -1,27 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 1829 lines to 37 lines, then from 47 lines to 18 lines *) - -Class Contr_internal (A : Type) := - BuildContr { center : A ; - contr : (forall y : A, True) }. -Class Contr A := Contr_is_contr : Contr_internal A. -Inductive Unit : Set := tt. -Instance contr_unit : Contr Unit | 0 := - let x := {| - center := tt; - contr := fun t : Unit => I - |} in x. (* success *) - -Instance contr_internal_unit' : Contr_internal Unit | 0 := - {| - center := tt; - contr := fun t : Unit => I - |}. - -Instance contr_unit' : Contr Unit | 0 := - {| - center := tt; - contr := fun t : Unit => I - |}. -(* Error: Mismatched contexts while declaring instance: - Expected: (Contr_is_contr : Contr_internal _UNBOUND_REL_1) - Found: tt (fun t : Unit => I) *) diff --git a/test-suite/bugs/closed/3291.v b/test-suite/bugs/closed/3291.v deleted file mode 100644 index 4ea748c0fb..0000000000 --- a/test-suite/bugs/closed/3291.v +++ /dev/null @@ -1,9 +0,0 @@ -Require Import Setoid. - -Definition segv : forall x, (x = 0%nat) -> (forall (y : nat), (y < x)%nat -> nat) = forall (y : nat), (y < 0)%nat -> nat. -intros x eq. -assert (H : forall y, (y < x)%nat = (y < 0)%nat). -rewrite -> eq. auto. -Set Typeclasses Debug. -Fail setoid_rewrite <- H. (* The command has indeed failed with message: -=> Stack overflow. *) diff --git a/test-suite/bugs/closed/3294.v b/test-suite/bugs/closed/3294.v deleted file mode 100644 index ed1a0c29ae..0000000000 --- a/test-suite/bugs/closed/3294.v +++ /dev/null @@ -1,6 +0,0 @@ -Check (match true return - match eq_refl Type return Type with eq_refl => bool end - with _ => true end). -Check (match true return - match eq_refl Type with eq_refl => bool end - with _ => true end). diff --git a/test-suite/bugs/closed/3297.v b/test-suite/bugs/closed/3297.v deleted file mode 100644 index 1cacb97ff3..0000000000 --- a/test-suite/bugs/closed/3297.v +++ /dev/null @@ -1,12 +0,0 @@ -Goal forall (n : nat) (H := eq_refl : n = n) (H' : n = 0), H = eq_refl. - intros. - subst. (* Toplevel input, characters 15-20: -Error: Abstracting over the term "n" leads to a term -"λ n : nat, H = eq_refl" which is ill-typed. *) - Undo. - revert H. - subst. (* success *) - Undo. - intro. - clearbody H. - subst. (* success *) diff --git a/test-suite/bugs/closed/3298.v b/test-suite/bugs/closed/3298.v deleted file mode 100644 index f07ee1e6cf..0000000000 --- a/test-suite/bugs/closed/3298.v +++ /dev/null @@ -1,22 +0,0 @@ -Require Import TestSuite.admit. -Module JGross. - Hint Extern 1 => match goal with |- match ?E with end => case E end. - - Goal forall H : False, match H return Set with end. - Proof. - intros. - solve [ eauto ]. - Qed. -End JGross. - -Section BenDelaware. - Hint Extern 0 => admit. - Goal forall (H : False), id (match H return Set with end). - Proof. - eauto. - Qed. - Goal forall (H : False), match H return Set with end. - Proof. - solve [ eauto ] . - Qed. -End BenDelaware. diff --git a/test-suite/bugs/closed/3300.v b/test-suite/bugs/closed/3300.v deleted file mode 100644 index a28144b9ca..0000000000 --- a/test-suite/bugs/closed/3300.v +++ /dev/null @@ -1,7 +0,0 @@ -Set Primitive Projections. -Record Box (T : Type) : Prop := wrap {prop : T}. - -Definition down (x : Type) : Prop := Box x. -Definition up (x : Prop) : Type := x. - -Fail Definition back A : up (down A) -> A := @prop A. diff --git a/test-suite/bugs/closed/3305.v b/test-suite/bugs/closed/3305.v deleted file mode 100644 index f3f2195228..0000000000 --- a/test-suite/bugs/closed/3305.v +++ /dev/null @@ -1,13 +0,0 @@ -Require Export Coq.Classes.RelationClasses. - -Section defs. - Variable A : Type. - Variable lt : A -> A -> Prop. - Context {ltso : StrictOrder lt}. - - Goal forall (a : A), lt a a -> False. - Proof. - intros a H. - contradict (irreflexivity H). - Qed. -End defs. diff --git a/test-suite/bugs/closed/3306.v b/test-suite/bugs/closed/3306.v deleted file mode 100644 index 599e8391ac..0000000000 --- a/test-suite/bugs/closed/3306.v +++ /dev/null @@ -1,12 +0,0 @@ - -Inductive Foo(A : Type) : Prop := - foo: A -> Foo A. - -Arguments foo [A] _. - -Scheme Foo_elim := Induction for Foo Sort Prop. - -Goal forall (fn : Foo nat), { x: nat | foo x = fn }. -intro fn. -Fail induction fn as [n] using Foo_elim. (* should fail in a non-Prop context *) -Admitted. diff --git a/test-suite/bugs/closed/3310.v b/test-suite/bugs/closed/3310.v deleted file mode 100644 index d6c31c6b41..0000000000 --- a/test-suite/bugs/closed/3310.v +++ /dev/null @@ -1,11 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. - -CoInductive stream A := cons { hd : A; tl : stream A }. - -CoFixpoint id {A} (s : stream A) := cons (hd s) (id (tl s)). - -Lemma id_spec : forall A (s : stream A), id s = s. -Proof. -intros A s. -Fail change (id s) with (cons (hd (id s)) (tl (id s))). diff --git a/test-suite/bugs/closed/3314.v b/test-suite/bugs/closed/3314.v deleted file mode 100644 index a5782298c3..0000000000 --- a/test-suite/bugs/closed/3314.v +++ /dev/null @@ -1,148 +0,0 @@ -Require Import TestSuite.admit. -Set Universe Polymorphism. -Definition Lift -: ltac:(let U1 := constr:(Type) in - let U0 := constr:(Type : U1) in - exact (U0 -> U1)) - := fun T => T. - -Fail Check nat:Prop. (* The command has indeed failed with message: -=> Error: -The term "nat" has type "Set" while it is expected to have type "Prop". *) -Set Printing All. -Set Printing Universes. -Fail Check Lift nat : Prop. (* Lift (* Top.8 Top.9 Top.10 *) nat:Prop - : Prop -(* Top.10 - Top.9 - Top.8 |= Top.10 < Top.9 - Top.9 < Top.8 - Top.9 <= Prop - *) - *) -Fail Eval compute in Lift nat : Prop. -(* = nat - : Prop *) - -Section Hurkens. - - Monomorphic Definition Type2 := Type. - Monomorphic Definition Type1 := Type : Type2. - - (** Assumption of a retract from Type into Prop *) - - Variable down : Type1 -> Prop. - Variable up : Prop -> Type1. - - Hypothesis back : forall A, up (down A) -> A. - - Hypothesis forth : forall A, A -> up (down A). - - Hypothesis backforth : forall (A:Type) (P:A->Type) (a:A), - P (back A (forth A a)) -> P a. - - Hypothesis backforth_r : forall (A:Type) (P:A->Type) (a:A), - P a -> P (back A (forth A a)). - - (** Proof *) - - Definition V : Type1 := forall A:Prop, ((up A -> Prop) -> up A -> Prop) -> up A -> Prop. - Definition U : Type1 := V -> Prop. - - Definition sb (z:V) : V := fun A r a => r (z A r) a. - Definition le (i:U -> Prop) (x:U) : Prop := x (fun A r a => i (fun v => sb v A r a)). - Definition le' (i:up (down U) -> Prop) (x:up (down U)) : Prop := le (fun a:U => i (forth _ a)) (back _ x). - Definition induct (i:U -> Prop) : Type1 := forall x:U, up (le i x) -> up (i x). - Definition WF : U := fun z => down (induct (fun a => z (down U) le' (forth _ a))). - Definition I (x:U) : Prop := - (forall i:U -> Prop, up (le i x) -> up (i (fun v => sb v (down U) le' (forth _ x)))) -> False. - - Lemma Omega : forall i:U -> Prop, induct i -> up (i WF). - Proof. - intros i y. - apply y. - unfold le, WF, induct. - apply forth. - intros x H0. - apply y. - unfold sb, le', le. - compute. - apply backforth_r. - exact H0. - Qed. - - Lemma lemma1 : induct (fun u => down (I u)). - Proof. - unfold induct. - intros x p. - apply forth. - intro q. - generalize (q (fun u => down (I u)) p). - intro r. - apply back in r. - apply r. - intros i j. - unfold le, sb, le', le in j |-. - apply backforth in j. - specialize q with (i := fun y => i (fun v:V => sb v (down U) le' (forth _ y))). - apply q. - exact j. - Qed. - - Lemma lemma2 : (forall i:U -> Prop, induct i -> up (i WF)) -> False. - Proof. - intro x. - generalize (x (fun u => down (I u)) lemma1). - intro r; apply back in r. - apply r. - intros i H0. - apply (x (fun y => i (fun v => sb v (down U) le' (forth _ y)))). - unfold le, WF in H0. - apply back in H0. - exact H0. - Qed. - - Theorem paradox : False. - Proof. - exact (lemma2 Omega). - Qed. - -End Hurkens. - -Definition informative (x : bool) := - match x with - | true => Type - | false => Prop - end. - -Definition depsort (T : Type) (x : bool) : informative x := - match x with - | true => T - | false => True - end. - -(** This definition should fail *) -Fail Definition Box (T : Type1) : Prop := Lift T. - -Fail Definition prop {T : Type1} (t : Box T) : T := t. -Fail Definition wrap {T : Type1} (t : T) : Box T := t. - -Fail Definition down (x : Type1) : Prop := Box x. -Definition up (x : Prop) : Type1 := x. - -Fail Definition back A : up (down A) -> A := @prop A. - -Fail Definition forth (A : Type1) : A -> up (down A) := @wrap A. - -Fail Definition backforth (A:Type1) (P:A->Type) (a:A) : - P (back A (forth A a)) -> P a := fun H => H. - -Fail Definition backforth_r (A:Type1) (P:A->Type) (a:A) : - P a -> P (back A (forth A a)) := fun H => H. - -Theorem pandora : False. - Fail apply (paradox down up back forth backforth backforth_r). - admit. -Qed. - -Print Assumptions pandora. diff --git a/test-suite/bugs/closed/3315.v b/test-suite/bugs/closed/3315.v deleted file mode 100644 index b69097f921..0000000000 --- a/test-suite/bugs/closed/3315.v +++ /dev/null @@ -1,37 +0,0 @@ -Set Universe Polymorphism. -Set Primitive Projections. -Set Implicit Arguments. -Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. -Arguments existT {A} _ _ _. -Definition unpack_sigma' {A} {P : A -> Type} (Q : sigT P -> Type) (u : sigT P) : - Q (existT _ (projT1 u) (projT2 u)) -> Q u - := - fun H => - (let (x,p) as u return (Q (existT _ (projT1 u) (projT2 u)) -> Q u) := u in fun x : Q (existT _ _ p) => x) H. (* success *) -Definition unpack_sigma {A} {P : A -> Type} (Q : sigT P -> Type) (u : sigT P) : - Q (existT _ (projT1 u) (projT2 u)) -> Q u - := - fun H => - (let (x,p) as u return (Q (existT _ (projT1 u) (projT2 u)) -> Q u) := u in fun x => x) H. -(* Toplevel input, characters 219-229: -Error: -In environment -A : Type -P : A -> Type -Q : sigT P -> Type -u : sigT P -H : Q {| projT1 := projT1 u; projT2 := projT2 u |} -x : A -p : P x -The term - "fun - x : Q - {| - projT1 := projT1 {| projT1 := x; projT2 := p |}; - projT2 := projT2 {| projT1 := x; projT2 := p |} |} => x" has type - "Q - {| - projT1 := projT1 {| projT1 := x; projT2 := p |}; - projT2 := projT2 {| projT1 := x; projT2 := p |} |} -> -... " -*) diff --git a/test-suite/bugs/closed/3317.v b/test-suite/bugs/closed/3317.v deleted file mode 100644 index 8d152894ef..0000000000 --- a/test-suite/bugs/closed/3317.v +++ /dev/null @@ -1,94 +0,0 @@ -Set Implicit Arguments. -Module A. - Set Universe Polymorphism. - Set Primitive Projections. - Set Asymmetric Patterns. - Inductive paths {A} (x : A) : A -> Type := idpath : paths x x - where "x = y" := (@paths _ x y) : type_scope. - Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. - Arguments existT {A} _ _ _. - Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - Notation "x .1" := (projT1 x) (at level 3). - Notation "x .2" := (projT2 x) (at level 3). - Notation "( x ; y )" := (existT _ x y). - Set Printing All. - Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (pq : sigT (fun p : u.1 = v.1 => transport _ p u.2 = v.2)) - : u = v - := match pq with - | existT p q => - match u, v return (forall p0 : (u.1 = v.1), (transport P p0 u.2 = v.2) -> (u=v)) with - | (x;y), (x';y') => fun p1 (q1 : transport P p1 (existT P x y).2 = (existT P x' y').2) => - match p1 in (_ = x'') return (forall y'', (transport _ p1 y = y'') -> (x;y)=(x'';y'')) with - | idpath => fun y' (q2 : transport _ (@idpath _ _) y = y') => - match q2 in (_ = y'') return (x;y) = (x;y'') with - | idpath => @idpath _ _ - end - end y' q1 - end p q - end. - (* Toplevel input, characters 341-357: -Error: -In environment -A : Type -P : forall _ : A, Type -u : @sigT A P -v : @sigT A P -pq : -@sigT (@paths A (projT1 u) (projT1 v)) - (fun p : @paths A (projT1 u) (projT1 v) => - @paths (P (projT1 v)) (@transport A P (projT1 u) (projT1 v) p (projT2 u)) - (projT2 v)) -p : @paths A (projT1 u) (projT1 v) -q : -@paths (P (projT1 v)) (@transport A P (projT1 u) (projT1 v) p (projT2 u)) - (projT2 v) -x : A -y : P x -x' : A -y' : P x' -p1 : @paths A (projT1 (@existT A P x y)) (projT1 (@existT A P x' y')) -The term "projT2 (@existT A P x y)" has type "P (projT1 (@existT A P x y))" -while it is expected to have type "P (projT1 (@existT A P x y))". - *) -End A. - -Module B. - Set Universe Polymorphism. - Set Primitive Projections. - Set Asymmetric Patterns. - Inductive paths {A} (x : A) : A -> Type := idpath : paths x x - where "x = y" := (@paths _ x y) : type_scope. - Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. - Arguments existT {A} _ _ _. - Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - Notation "x .1" := (projT1 x) (at level 3). - Notation "x .2" := (projT2 x) (at level 3). - Notation "( x ; y )" := (existT _ x y). - Set Printing All. - - Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (pq : sigT (fun p : u.1 = v.1 => transport _ p u.2 = v.2)) - : u = v. - Proof. - destruct u as [x y]. - destruct v. (* Toplevel input, characters 0-11: -Error: Illegal application: -The term "transport" of type - "forall (A : Type) (P : forall _ : A, Type) (x y : A) - (_ : @paths A x y) (_ : P x), P y" -cannot be applied to the terms - "A" : "Type" - "P" : "forall _ : A, Type" - "projT1 (@existT A P x y)" : "A" - "projT1 v" : "A" - "p" : "@paths A (projT1 (@existT A P x y)) (projT1 v)" - "projT2 (@existT A P x y)" : "P (projT1 (@existT A P x y))" -The 5th term has type "@paths A (projT1 (@existT A P x y)) (projT1 v)" -which should be coercible to - "@paths A (projT1 (@existT A P x y)) (projT1 v)". - *) - Abort. -End B. diff --git a/test-suite/bugs/closed/3319.v b/test-suite/bugs/closed/3319.v deleted file mode 100644 index fbf5d86dcb..0000000000 --- a/test-suite/bugs/closed/3319.v +++ /dev/null @@ -1,26 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 5353 lines to 4545 lines, then from 4513 lines to 4504 lines, then from 4515 lines to 4508 lines, then from 4519 lines to 132 lines, then from 111 lines to 66 lines, then from 68 lines to 35 lines *) -Set Implicit Arguments. -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a - where "x = y" := (@paths _ x y) : type_scope. - -Record PreCategory := { obj :> Type; morphism : obj -> obj -> Type }. -Record NotionOfStructure (X : PreCategory) := - { structure :> X -> Type; - is_structure_homomorphism - : forall x y (f : morphism X x y) (a : structure x) (b : structure y), Type }. - -Section precategory. - Variable X : PreCategory. - Variable P : NotionOfStructure X. - Local Notation object := { x : X & P x }. - Record morphism' (xa yb : object) := {}. - - Lemma issig_morphism xa yb - : { f : morphism X (projT1 xa) (projT1 yb) - & is_structure_homomorphism _ _ _ f (projT2 xa) (projT2 yb) } - = morphism' xa yb. - Proof. - admit. - Defined. diff --git a/test-suite/bugs/closed/3320.v b/test-suite/bugs/closed/3320.v deleted file mode 100644 index a5c243d8e3..0000000000 --- a/test-suite/bugs/closed/3320.v +++ /dev/null @@ -1,5 +0,0 @@ -Goal forall x : nat, True. - fix goal 1. - assumption. -Fail Qed. -Undo. diff --git a/test-suite/bugs/closed/3321.v b/test-suite/bugs/closed/3321.v deleted file mode 100644 index b6f10e533e..0000000000 --- a/test-suite/bugs/closed/3321.v +++ /dev/null @@ -1,19 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 5302 lines to 4649 lines, then from 4660 lines to 355 lines, then from 360 lines to 269 lines, then from 269 lines to 175 lines, then from 144 lines to 119 lines, then from 103 lines to 83 lines, then from 86 lines to 36 lines, then from 37 lines to 17 lines *) - -Axiom admit : forall {T}, T. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. -Record Equiv A B := BuildEquiv { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. -Definition equiv_path (A B : Type) (p : A = B) : Equiv A B := admit. -Class Univalence := { isequiv_equiv_path :> forall (A B : Type), IsEquiv (equiv_path A B) }. -Definition path_universe `{Univalence} {A B : Type} (f : A -> B) {feq : IsEquiv f} : (A = B) := admit. -Context `{ua:Univalence}. -Variable A:Type. -Goal forall (I : Type) (f : I -> A), - {p : I = {a : A & @hfiber I A f a} & True }. -intros. -clear. -try exists (path_universe admit). (* Toplevel input, characters 15-44: -Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/3322.v b/test-suite/bugs/closed/3322.v deleted file mode 100644 index ab3025a6aa..0000000000 --- a/test-suite/bugs/closed/3322.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 11971 lines to 11753 lines, then from 7702 lines to 564 lines, then from 571 lines to 61 lines *) -Set Asymmetric Patterns. -Axiom admit : forall {T}, T. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (pq : {p : (projT1 u) = (projT1 v) & transport _ p (projT2 u) = (projT2 v)}) -: u = v. -Proof. - destruct pq as [p q], u as [x y], v as [x' y']; simpl in *. - destruct p, q; simpl; reflexivity. -Defined. -Arguments path_sigma_uncurried : simpl never. -Section opposite. - Let opposite_functor_involutive_helper - := @path_sigma_uncurried admit admit (existT _ admit admit) admit (existT _ admit admit). - - Goal True. - Opaque path_sigma_uncurried. - simpl in *. - Transparent path_sigma_uncurried. - (* This command should fail with "Error: Failed to progress.", as it does in 8.4; the simpl never directive should prevent simpl from progressing *) - Fail progress simpl in *. diff --git a/test-suite/bugs/closed/3323.v b/test-suite/bugs/closed/3323.v deleted file mode 100644 index 4622634eaa..0000000000 --- a/test-suite/bugs/closed/3323.v +++ /dev/null @@ -1,78 +0,0 @@ -Require Import TestSuite.admit. -(* -*- coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 5302 lines to 4649 lines, then from 4660 lines to 355 lines, then from 360 lines to 269 lines, then from 269 lines to 175 lines, then from 144 lines to 119 lines, then from 297 lines to 117 lines, then from 95 lines to 79 lines, then from 82 lines to 68 lines *) - -Set Universe Polymorphism. -Generalizable All Variables. -Inductive sigT {A:Type} (P:A -> Type) : Type := existT : forall x:A, P x -> sigT P. -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. -Definition projT1 {A} {P : A -> Type} (x : sigT P) : A := let (a, _) := x in a. -Definition projT2 {A} {P : A -> Type} (x : sigT P) : P (projT1 x) := let (a, h) return P (projT1 x) := x in h. -Axiom admit : forall {T}, T. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. -Record Equiv A B := BuildEquiv { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Existing Instance equiv_isequiv. -Global Instance isequiv_inverse `{IsEquiv A B f} : IsEquiv (@equiv_inv _ _ f _) | 10000 := admit. -Definition equiv_path_sigma `(P : A -> Type) (u v : sigT P) -: Equiv {p : projT1 u = projT1 v & transport _ p (projT2 u) = projT2 v} (u = v) := admit. -Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. -Definition path_universe {A B : Type} (f : A -> B) : (A = B) := admit. -Section AssumeFunext. - Let equiv_fibration_replacement_eissect {B C f} - : forall x : {y : B & {x : C & f x = y}}, - existT _ (f (projT1 (projT2 x))) (existT _ (projT1 (projT2 x)) idpath) = x. - admit. - Defined. - Definition equiv_fibration_replacement {B C} (f:C ->B): - Equiv C {y:B & {x:C & f x = y}}. - Proof. - refine (BuildEquiv - _ _ _ - (BuildIsEquiv - C {y:B & {x:C & f x = y}} - (fun c => existT _ (f c) (existT _ c idpath)) - (fun c => projT1 (projT2 c)) - equiv_fibration_replacement_eissect)). - Defined. - Definition equiv_total_paths (A : Type) (P : A-> Type) (x y : sigT P) : - Equiv (x = y) { p : projT1 x = projT1 y & transport P p (projT2 x) = (projT2 y) } - := BuildEquiv _ _ (@equiv_inv _ _ _ (equiv_path_sigma P x y)) _. - Variable A:Type. - Definition Fam A:=sigT (fun I:Type => I->A). - Definition p2f: (A->Type)-> Fam A := fun Q:(A->Type) => existT _ (sigT Q) (@projT1 _ _). - Definition f2p: Fam A -> (A->Type) := fun F => let (I, f) := F in (fun a => (hfiber f a)). - Definition exp {U V:Type}(w:Equiv U V):Equiv (U->A) (V->A). - exists (fun f:(U->A)=> (fun x => (f (@equiv_inv _ _ w _ x)))). - admit. - Defined. - Goal { h : Fam A -> A -> Type & Sect h p2f }. - exists f2p. - intros [I f]. - set (e:=@equiv_total_paths _ _ (@existT Type (fun I0 : Type => I0 -> A) I f) - (existT _ {a : A & hfiber f a} (@projT1 _ _))). - simpl in e. - cut ( {p : I = {a : A & @hfiber I A f a} & - @transport _ (fun I0 : Type => I0 -> A) _ _ p f = @projT1 _ _}). - { intro X. - apply (inverse (@equiv_inv _ _ _ e X)). } - set (w:=@equiv_fibration_replacement A I f). - exists (path_universe w). - assert (forall x, (exp w) f x = projT1 x); [ | admit ]. - intros [a [i p]]. - exact p. - Qed. -(* Toplevel input, characters 15-19: -Error: In pattern-matching on term "x" the branch for constructor -"existT(*Top.256 Top.258*)" has type - "forall (I : Type) (f : I -> A), - existT (fun I0 : Type => I0 -> A) {a : A & hfiber f a} projT1 = - existT (fun I0 : Type => I0 -> A) I f" which should be - "forall (x : Type) (H : x -> A), - p2f (f2p (existT (fun I : Type => I -> A) x H)) = - existT (fun I : Type => I -> A) x H". - *) diff --git a/test-suite/bugs/closed/3324.v b/test-suite/bugs/closed/3324.v deleted file mode 100644 index 45dbb57aa2..0000000000 --- a/test-suite/bugs/closed/3324.v +++ /dev/null @@ -1,48 +0,0 @@ -Require Import TestSuite.admit. -Module ETassi. - Axiom admit : forall {T}, T. - Class IsHProp (A : Type) : Type := {}. - Class IsHSet (A : Type) : Type := {}. - Record hProp := hp { hproptype :> Type ; isp : IsHProp hproptype}. - Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. - Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). - Global Instance isset_hProp : IsHSet hProp | 0. - - Check (eq_refl _ : setT (default_HSet _ _) = hProp). - Check (eq_refl _ : setT _ = hProp). -End ETassi. - -Module JGross. - (* File reduced by coq-bug-finder from original input, then from 6462 lines to 5760 lines, then from 5761 lines to 181 lines, then from 191 lines to 181 lines, then from 181 lines to 83 lines, then from 87 lines to 27 lines *) - Axiom admit : forall {T}, T. - Class IsHProp (A : Type) : Type := {}. - Class IsHSet (A : Type) : Type := {}. - Inductive Unit : Set := tt. - Record hProp := hp { hproptype :> Type ; isp : IsHProp hproptype}. - Definition Unit_hp:hProp:=(hp Unit admit). - Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. - Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). - Global Instance isset_hProp : IsHSet hProp | 0. - Definition isepi {X Y} `(f:X->Y) := forall Z: hSet, - forall g h: Y -> Z, (fun x => g (f x)) = (fun x => h (f x)) -> g = h. - Lemma isepi_issurj {X Y} (f:X->Y): isepi f -> True. - Proof. - intros epif. - set (g :=fun _:Y => Unit_hp). - pose proof (epif (default_HSet hProp isset_hProp) g). - specialize (epif _ g). - (* Toplevel input, characters 34-35: -Error: -In environment -X : Type -Y : Type -f : X -> Y -epif : isepi f -g := fun _ : Y => Unit_hp : Y -> hProp -H : forall h : Y -> default_HSet hProp isset_hProp, - (fun x : X => g (f x)) = (fun x : X => h (f x)) -> g = h -The term "g" has type "Y -> hProp" while it is expected to have type - "Y -> ?30". - *) - Abort. -End JGross. diff --git a/test-suite/bugs/closed/3325.v b/test-suite/bugs/closed/3325.v deleted file mode 100644 index 36c065ebe8..0000000000 --- a/test-suite/bugs/closed/3325.v +++ /dev/null @@ -1,48 +0,0 @@ -Typeclasses eauto := debug. -Set Printing All. - -Axiom SProp : Set. -Axiom sp : SProp. - -(* If we hardcode valueType := nat, it goes through *) -Class StateIs := { - valueType : Type; - stateIs : valueType -> SProp -}. - -Instance NatStateIs : StateIs := { - valueType := nat; - stateIs := fun _ => sp -}. -Canonical Structure NatStateIs. - -Class LogicOps F := { land: F -> F }. -Instance : LogicOps SProp. Admitted. -Instance : LogicOps Prop. Admitted. - -Parameter (n : nat). -(* If this is a [Definition], the resolution goes through fine. *) -Notation vn := (@stateIs _ n). -Definition vn' := (@stateIs _ n). -Definition GOOD : SProp := - @land _ _ vn'. -(* This doesn't resolve, if PropLogicOps is defined later than SPropLogicOps *) -Definition BAD : SProp := - @land _ _ vn. - - -Class A T := { foo : T -> Prop }. -Instance: A nat. Admitted. -Instance: A Set. Admitted. - -Class B := { U : Type ; b : U }. -Instance bi: B := {| U := nat ; b := 0 |}. -Canonical Structure bi. - -Notation b0N := (@b _ : nat). -Notation b0Ni := (@b bi : nat). -Definition b0D := (@b _ : nat). -Definition GOOD1 := (@foo _ _ b0D). -Definition GOOD2 := (let x := b0N in @foo _ _ x). -Definition GOOD3 := (@foo _ _ b0Ni). -Definition BAD1 := (@foo _ _ b0N). (* Error: The term "b0Ni" has type "nat" while it is expected to have type "Set". *) diff --git a/test-suite/bugs/closed/3326.v b/test-suite/bugs/closed/3326.v deleted file mode 100644 index 4d7e9f77cb..0000000000 --- a/test-suite/bugs/closed/3326.v +++ /dev/null @@ -1,19 +0,0 @@ -Class ORDER A := Order { - LEQ : A -> A -> bool; - leqRefl: forall x, true = LEQ x x -}. - -Section XXX. - -Variable A:Type. -Variable (O:ORDER A). -Definition aLeqRefl := @leqRefl _ O. - -Lemma OK : forall x, true = LEQ x x. -Proof. - intros. - unfold LEQ. - destruct O. - clear. - Fail apply aLeqRefl. -Abort. diff --git a/test-suite/bugs/closed/3329.v b/test-suite/bugs/closed/3329.v deleted file mode 100644 index ecb09e8436..0000000000 --- a/test-suite/bugs/closed/3329.v +++ /dev/null @@ -1,94 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 12095 lines to 869 lines, then from 792 lines to 504 lines, then from 487 lines to 353 lines, then from 258 lines to 174 lines, then from 164 lines to 132 lines, then from 129 lines to 99 lines *) -Set Universe Polymorphism. -Generalizable All Variables. -Axiom admit : forall {T}, T. -Reserved Notation "g 'o' f" (at level 40, left associativity). -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Notation "g 'o' f" := (compose g f). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) : Type := forall x:A, f x = g x. -Hint Unfold pointwise_paths : typeclass_instances. -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) -: forall x, f x = g x - := fun x => match h with idpath => idpath end. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A }. -Class IsHSet (A : Type) := { _ : False }. -Class Funext := { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - trunc_morphism : forall s d, IsHSet (morphism s d) }. - -Definition trunc_equiv `(f : A -> B) `{IsHSet A} `{IsEquiv A B f} : IsHSet B := admit. -Global Instance trunc_forall `{Funext} `{P : A -> Type} `{forall a, IsHSet (P a)} -: IsHSet (forall a, P a) | 100. -Proof. - generalize dependent P. - intro P. - assert (f : forall a, P a) by admit. - assert (g : forall a, P a) by admit. - pose (@trunc_equiv (forall x : A, @paths (P x) (f x) (g x)) - (@paths (forall x : A, P x) f g) - (@equiv_inv (@paths (forall x : A, P x) f g) - (forall x : A, @paths (P x) (f x) (g x)) - (@apD10 A P f g) (@isequiv_apD10 H A P f g))). - admit. -Defined. -Record Functor (C D : PreCategory) := { object_of :> C -> D }. -Definition identity C : Functor C C := Build_Functor C C admit. -Notation "1" := (identity _) : functor_scope. -Definition functor_category (C D : PreCategory) : PreCategory - := @Build_PreCategory (Functor C D) admit admit. -Notation "C -> D" := (functor_category C D) : category_scope. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. -Global Existing Instance iss. -Definition set_cat `{Funext} : PreCategory := - @Build_PreCategory hSet - (fun x y => x -> y) - _. - -Section hom_functor. - Context `{Funext}. - Variable C : PreCategory. - - Local Notation obj_of c'c := - (BuildhSet - (morphism - C - c'c - c'c) - admit). - Let hom_functor_morphism_of s's d'd (hf : morphism C s's d'd) - : morphism set_cat (obj_of s's) (obj_of d'd) - := admit. - - Definition hom_functor : Functor C set_cat := admit. -End hom_functor. -Local Open Scope category_scope. -Local Open Scope functor_scope. -Context `{Funext}. -Variable D : PreCategory. -Set Printing Universes. -Check hom_functor D o 1. -(* Toplevel input, characters 20-44: -Error: Illegal application: -The term "@set_cat" of type "(Funext -> PreCategory)%type" -cannot be applied to the term - "H" : "Funext" -This term has type "Funext" which should be coercible to -"Funext". *) -(* The command has indeed failed with message: -=> Error: Illegal application: -The term "@set_cat@{Top.345 Top.346 Top.331 Top.332 Top.337 Top.338 Top.339}" -of type - "(Funext@{Top.346 Top.346 Top.331 Top.332 Top.346} -> PreCategory@{Top.345 - Top.346})%type" -cannot be applied to the term - "H@{Top.346 Top.330 Top.331 Top.332 Top.333}" - : "Funext@{Top.346 Top.330 Top.331 Top.332 Top.333}" -This term has type "Funext@{Top.346 Top.330 Top.331 Top.332 Top.333}" -which should be coercible to - "Funext@{Top.346 Top.346 Top.331 Top.332 Top.346}". -*) diff --git a/test-suite/bugs/closed/3330.v b/test-suite/bugs/closed/3330.v deleted file mode 100644 index 672fb3f131..0000000000 --- a/test-suite/bugs/closed/3330.v +++ /dev/null @@ -1,1115 +0,0 @@ -Unset Strict Universe Declaration. -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 12106 lines to 1070 lines *) -Set Universe Polymorphism. -Definition setleq (A : Type@{i}) (B : Type@{j}) := A : Type@{j}. - -Inductive foo : Type@{l} := bar : foo . -Section MakeEq. - Variables (a : foo@{i}) (b : foo@{j}). - - Let t := ltac:(let ty := type of b in exact ty). - Definition make_eq (x:=b) := a : t. -End MakeEq. - -Definition same (x : foo@{i}) (y : foo@{i}) := x. - -Section foo. - - Variables x : foo@{i}. - Variables y : foo@{j}. - - Let AleqB := let foo := make_eq x y in (Type * Type)%type. - - Definition baz := same x y. -End foo. - -Definition baz' := Eval unfold baz in baz@{i j k l}. - -Module Export HoTT_DOT_Overture. -Module Export HoTT. -Module Export Overture. - -Definition relation (A : Type) := A -> A -> Type. -Class Symmetric {A} (R : relation A) := - symmetry : forall x y, R x y -> R y x. - -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := - fun x => g (f x). - -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. - -Open Scope function_scope. - -Set Printing Universes. Set Printing All. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Notation "x = y :> A" := (@paths A x y) : type_scope. - -Notation "x = y" := (x = y :>_) : type_scope. - -Delimit Scope path_scope with path. - -Local Open Scope path_scope. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Instance symmetric_paths {A} : Symmetric (@paths A) | 0 := @inverse A. - -Notation "1" := idpath : path_scope. - -Notation "p @ q" := (concat p q) (at level 20) : path_scope. - -Notation "p ^" := (inverse p) (at level 3) : path_scope. - -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) : Type - := forall x:A, f x = g x. - -Hint Unfold pointwise_paths : typeclass_instances. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) - : f == g - := fun x => match h with idpath => 1 end. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) -}. - -Delimit Scope equiv_scope with equiv. - -Local Open Scope equiv_scope. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) -}. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Fixpoint nat_to_trunc_index (n : nat) : trunc_index - := match n with - | 0 => trunc_S (trunc_S minus_two) - | S n' => trunc_S (nat_to_trunc_index n') - end. - -Coercion nat_to_trunc_index : nat >-> trunc_index. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Notation IsHSet := (IsTrunc 0). - -Class Funext := - { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. - -Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x) : - f == g -> f = g - := - (@apD10 A P f g)^-1. - -End Overture. - -End HoTT. - -End HoTT_DOT_Overture. - -Module Export HoTT_DOT_categories_DOT_Category_DOT_Core. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Delimit Scope morphism_scope with morphism. - -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. -Set Printing Universes. -Set Printing All. -Record PreCategory := - Build_PreCategory' { - object :> Type; - morphism : object -> object -> Type; - - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g); - - associativity : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - (m3 o m2) o m1 = m3 o (m2 o m1); - - associativity_sym : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - m3 o (m2 o m1) = (m3 o m2) o m1; - - left_identity : forall a b (f : morphism a b), identity b o f = f; - right_identity : forall a b (f : morphism a b), f o identity a = f; - - identity_identity : forall x, identity x o identity x = identity x; - - trunc_morphism : forall s d, IsHSet (morphism s d) - }. - -Bind Scope category_scope with PreCategory. - -Arguments identity [!C%category] x%object : rename. -Arguments compose [!C%category s%object d%object d'%object] m1%morphism m2%morphism : rename. - -Definition Build_PreCategory - object morphism compose identity - associativity left_identity right_identity - := @Build_PreCategory' - object - morphism - compose - identity - associativity - (fun _ _ _ _ _ _ _ => symmetry _ _ (associativity _ _ _ _ _ _ _)) - left_identity - right_identity - (fun _ => left_identity _ _ _). - -Existing Instance trunc_morphism. - -Hint Resolve @left_identity @right_identity @associativity : category morphism. - -Module Export CategoryCoreNotations. - - Infix "o" := compose : morphism_scope. -End CategoryCoreNotations. -End Core. - -End Category. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Category_DOT_Core. - -Module Export HoTT_DOT_types_DOT_Forall. - -Module Export HoTT. -Module Export types. -Module Export Forall. -Generalizable Variables A B f g e n. - -Section AssumeFunext. - -Global Instance trunc_forall `{P : A -> Type} `{forall a, IsTrunc n (P a)} - : IsTrunc n (forall a, P a) | 100. - -admit. -Defined. -End AssumeFunext. - -End Forall. - -End types. - -End HoTT. - -End HoTT_DOT_types_DOT_Forall. - -Module Export HoTT_DOT_types_DOT_Prod. - -Module Export HoTT. -Module Export types. -Module Export Prod. -Local Open Scope path_scope. - -Definition path_prod_uncurried {A B : Type} (z z' : A * B) - (pq : (fst z = fst z') * (snd z = snd z')) - : (z = z') - := match pq with (p,q) => - match z, z' return - (fst z = fst z') -> (snd z = snd z') -> (z = z') with - | (a,b), (a',b') => fun p q => - match p, q with - idpath, idpath => 1 - end - end p q - end. - -Definition path_prod {A B : Type} (z z' : A * B) : - (fst z = fst z') -> (snd z = snd z') -> (z = z') - := fun p q => path_prod_uncurried z z' (p,q). - -Definition path_prod' {A B : Type} {x x' : A} {y y' : B} - : (x = x') -> (y = y') -> ((x,y) = (x',y')) - := fun p q => path_prod (x,y) (x',y') p q. - -End Prod. - -End types. - -End HoTT. - -End HoTT_DOT_types_DOT_Prod. - -Module Export HoTT_DOT_categories_DOT_Functor_DOT_Core. - -Module Export HoTT. -Module Export categories. -Module Export Functor. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Delimit Scope functor_scope with functor. - -Local Open Scope morphism_scope. - -Section Functor. - - Variable C : PreCategory. - Variable D : PreCategory. - - Record Functor := - { - object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d); - composition_of : forall s d d' - (m1 : morphism C s d) (m2: morphism C d d'), - morphism_of _ _ (m2 o m1) - = (morphism_of _ _ m2) o (morphism_of _ _ m1); - identity_of : forall x, morphism_of _ _ (identity x) - = identity (object_of x) - }. - -End Functor. -Bind Scope functor_scope with Functor. - -Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. -Module Export FunctorCoreNotations. - - Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. -End FunctorCoreNotations. -End Core. - -End Functor. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Functor_DOT_Core. - -Module Export HoTT_DOT_categories_DOT_Category_DOT_Morphisms. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Morphisms. -Set Universe Polymorphism. - -Local Open Scope morphism_scope. - -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := - { - morphism_inverse : morphism C d s; - left_inverse : morphism_inverse o m = identity _; - right_inverse : m o morphism_inverse = identity _ - }. - -Class Isomorphic {C : PreCategory} s d := - { - morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic - }. - -Module Export CategoryMorphismsNotations. - - Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. - -End CategoryMorphismsNotations. -End Morphisms. - -End Category. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Category_DOT_Morphisms. - -Module Export HoTT_DOT_categories_DOT_Category_DOT_Dual. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Dual. -Set Universe Polymorphism. - -Local Open Scope morphism_scope. - -Section opposite. - - Definition opposite (C : PreCategory) : PreCategory - := @Build_PreCategory' - C - (fun s d => morphism C d s) - (identity (C := C)) - (fun _ _ _ m1 m2 => m2 o m1) - (fun _ _ _ _ _ _ _ => @associativity_sym _ _ _ _ _ _ _ _) - (fun _ _ _ _ _ _ _ => @associativity _ _ _ _ _ _ _ _) - (fun _ _ => @right_identity _ _ _) - (fun _ _ => @left_identity _ _ _) - (@identity_identity C) - _. -End opposite. - -Module Export CategoryDualNotations. - - Notation "C ^op" := (opposite C) (at level 3) : category_scope. -End CategoryDualNotations. -End Dual. - -End Category. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Category_DOT_Dual. - -Module Export HoTT_DOT_categories_DOT_Functor_DOT_Composition_DOT_Core. - -Module Export HoTT. -Module Export categories. -Module Export Functor. -Module Export Composition. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope morphism_scope. - -Section composition. - - Variable C : PreCategory. - Variable D : PreCategory. - Variable E : PreCategory. - Variable G : Functor D E. - Variable F : Functor C D. - - Local Notation c_object_of c := (G (F c)) (only parsing). - - Local Notation c_morphism_of m := (morphism_of G (morphism_of F m)) (only parsing). - - Let compose_composition_of' s d d' - (m1 : morphism C s d) (m2 : morphism C d d') - : c_morphism_of (m2 o m1) = c_morphism_of m2 o c_morphism_of m1. -admit. -Defined. - Definition compose_composition_of s d d' m1 m2 - := Eval cbv beta iota zeta delta - [compose_composition_of'] in - @compose_composition_of' s d d' m1 m2. - Let compose_identity_of' x - : c_morphism_of (identity x) = identity (c_object_of x). - -admit. -Defined. - Definition compose_identity_of x - := Eval cbv beta iota zeta delta - [compose_identity_of'] in - @compose_identity_of' x. - Definition compose : Functor C E - := Build_Functor - C E - (fun c => G (F c)) - (fun _ _ m => morphism_of G (morphism_of F m)) - compose_composition_of - compose_identity_of. - -End composition. -Module Export FunctorCompositionCoreNotations. - - Infix "o" := compose : functor_scope. -End FunctorCompositionCoreNotations. -End Core. - -End Composition. - -End Functor. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Functor_DOT_Composition_DOT_Core. - -Module Export HoTT_DOT_categories_DOT_Functor_DOT_Dual. - -Module Export HoTT. -Module Export categories. -Module Export Functor. -Module Export Dual. -Set Universe Polymorphism. - -Set Implicit Arguments. - -Section opposite. - - Variable C : PreCategory. - Variable D : PreCategory. - Definition opposite (F : Functor C D) : Functor C^op D^op - := Build_Functor (C^op) (D^op) - (object_of F) - (fun s d => morphism_of F (s := d) (d := s)) - (fun d' d s m1 m2 => composition_of F s d d' m2 m1) - (identity_of F). - -End opposite. -Module Export FunctorDualNotations. - - Notation "F ^op" := (opposite F) : functor_scope. -End FunctorDualNotations. -End Dual. - -End Functor. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Functor_DOT_Dual. - -Module Export HoTT_DOT_categories_DOT_Functor_DOT_Identity. - -Module Export HoTT. -Module Export categories. -Module Export Functor. -Module Export Identity. -Set Universe Polymorphism. - -Section identity. - - Definition identity C : Functor C C - := Build_Functor C C - (fun x => x) - (fun _ _ x => x) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). -End identity. -Module Export FunctorIdentityNotations. - - Notation "1" := (identity _) : functor_scope. -End FunctorIdentityNotations. -End Identity. - -End Functor. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Functor_DOT_Identity. - -Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Core. - -Module Export HoTT. -Module Export categories. -Module Export NaturalTransformation. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope morphism_scope. - -Section NaturalTransformation. - - Variable C : PreCategory. - Variable D : PreCategory. - Variables F G : Functor C D. - - Record NaturalTransformation := - Build_NaturalTransformation' { - components_of :> forall c, morphism D (F c) (G c); - commutes : forall s d (m : morphism C s d), - components_of d o F _1 m = G _1 m o components_of s; - - commutes_sym : forall s d (m : C.(morphism) s d), - G _1 m o components_of s = components_of d o F _1 m - }. - -End NaturalTransformation. -End Core. - -End NaturalTransformation. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Core. - -Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Dual. - -Module Export HoTT. -Module Export categories. -Module Export NaturalTransformation. -Module Export Dual. -Set Universe Polymorphism. - -Section opposite. - - Variable C : PreCategory. - Variable D : PreCategory. - - Definition opposite - (F G : Functor C D) - (T : NaturalTransformation F G) - : NaturalTransformation G^op F^op - := Build_NaturalTransformation' (G^op) (F^op) - (components_of T) - (fun s d => commutes_sym T d s) - (fun s d => commutes T d s). - -End opposite. - -End Dual. - -End NaturalTransformation. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Dual. - -Module Export HoTT_DOT_categories_DOT_Category_DOT_Strict. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Strict. - -Export Category.Core. -Set Universe Polymorphism. - -End Strict. - -End Category. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Category_DOT_Strict. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Prod. -Set Universe Polymorphism. - -Local Open Scope morphism_scope. - -Section prod. - - Variable C : PreCategory. - Variable D : PreCategory. - Definition prod : PreCategory. - - refine (@Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) - * morphism D (snd s) (snd d))%type) - (fun x => (identity (fst x), identity (snd x))) - (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1)) - _ - _ - _ - _); admit. - Defined. -End prod. -Module Export CategoryProdNotations. - - Infix "*" := prod : category_scope. -End CategoryProdNotations. -End Prod. - -End Category. - -End categories. - -End HoTT. - -Module Functor. -Module Export Prod. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope morphism_scope. - -Section proj. - - Context {C : PreCategory}. - Context {D : PreCategory}. - Definition fst : Functor (C * D) C - := Build_Functor (C * D) C - (@fst _ _) - (fun _ _ => @fst _ _) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). - - Definition snd : Functor (C * D) D - := Build_Functor (C * D) D - (@snd _ _) - (fun _ _ => @snd _ _) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). - -End proj. - -Section prod. - - Variable C : PreCategory. - Variable D : PreCategory. - Variable D' : PreCategory. - Definition prod (F : Functor C D) (F' : Functor C D') - : Functor C (D * D') - := Build_Functor - C (D * D') - (fun c => (F c, F' c)) - (fun s d m => (F _1 m, F' _1 m)) - (fun _ _ _ _ _ => path_prod' (composition_of F _ _ _ _ _) - (composition_of F' _ _ _ _ _)) - (fun _ => path_prod' (identity_of F _) (identity_of F' _)). - -End prod. -Local Infix "*" := prod : functor_scope. - -Section pair. - - Variable C : PreCategory. - Variable D : PreCategory. - Variable C' : PreCategory. - Variable D' : PreCategory. - Variable F : Functor C D. - Variable F' : Functor C' D'. - Definition pair : Functor (C * C') (D * D') - := (F o fst) * (F' o snd). - -End pair. - -Module Export FunctorProdNotations. - - Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : functor_scope. -End FunctorProdNotations. -End Prod. - -End Functor. - -Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core. - -Module Export HoTT. -Module categories. -Module Export NaturalTransformation. -Module Export Composition. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope path_scope. - -Local Open Scope morphism_scope. - -Section composition. - - Section compose. - Variable C : PreCategory. - Variable D : PreCategory. - Variables F F' F'' : Functor C D. - Variable T' : NaturalTransformation F' F''. - - Variable T : NaturalTransformation F F'. - Local Notation CO c := (T' c o T c). - - Definition compose_commutes s d (m : morphism C s d) - : CO d o morphism_of F m = morphism_of F'' m o CO s - := (associativity _ _ _ _ _ _ _ _) - @ ap (fun x => _ o x) (commutes T _ _ m) - @ (associativity_sym _ _ _ _ _ _ _ _) - @ ap (fun x => x o _) (commutes T' _ _ m) - @ (associativity _ _ _ _ _ _ _ _). - - Definition compose_commutes_sym s d (m : morphism C s d) - : morphism_of F'' m o CO s = CO d o morphism_of F m - := (associativity_sym _ _ _ _ _ _ _ _) - @ ap (fun x => x o _) (commutes_sym T' _ _ m) - @ (associativity _ _ _ _ _ _ _ _) - @ ap (fun x => _ o x) (commutes_sym T _ _ m) - @ (associativity_sym _ _ _ _ _ _ _ _). - - Definition compose - : NaturalTransformation F F'' - := Build_NaturalTransformation' F F'' - (fun c => CO c) - compose_commutes - compose_commutes_sym. - - End compose. - End composition. -Module Export NaturalTransformationCompositionCoreNotations. - - Infix "o" := compose : natural_transformation_scope. -End NaturalTransformationCompositionCoreNotations. -End Core. - -End Composition. - -End NaturalTransformation. - -End categories. - -Set Universe Polymorphism. - -Section path_natural_transformation. - - Context `{Funext}. - Variable C : PreCategory. - - Variable D : PreCategory. - Variables F G : Functor C D. - - Global Instance trunc_natural_transformation - : IsHSet (NaturalTransformation F G). - -admit. -Defined. - Section path. - - Variables T U : NaturalTransformation F G. - - Lemma path'_natural_transformation - : components_of T = components_of U - -> T = U. - -admit. -Defined. - Lemma path_natural_transformation - : components_of T == components_of U - -> T = U. - - Proof. - intros. - apply path'_natural_transformation. - apply path_forall; assumption. - Qed. - End path. -End path_natural_transformation. - -Ltac path_natural_transformation := - repeat match goal with - | _ => intro - | _ => apply path_natural_transformation; simpl - end. - -Module Export Identity. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope morphism_scope. - -Local Open Scope path_scope. -Section identity. - - Variable C : PreCategory. - Variable D : PreCategory. - - Section generalized. - - Variables F G : Functor C D. - Hypothesis HO : object_of F = object_of G. - Hypothesis HM : transport (fun GO => forall s d, - morphism C s d - -> morphism D (GO s) (GO d)) - HO - (morphism_of F) - = morphism_of G. - Local Notation CO c := (transport (fun GO => morphism D (F c) (GO c)) - HO - (identity (F c))). - - Definition generalized_identity_commutes s d (m : morphism C s d) - : CO d o morphism_of F m = morphism_of G m o CO s. - - Proof. - case HM. -case HO. - exact (left_identity _ _ _ _ @ (right_identity _ _ _ _)^). - Defined. - Definition generalized_identity_commutes_sym s d (m : morphism C s d) - : morphism_of G m o CO s = CO d o morphism_of F m. - -admit. -Defined. - Definition generalized_identity - : NaturalTransformation F G - := Build_NaturalTransformation' - F G - (fun c => CO c) - generalized_identity_commutes - generalized_identity_commutes_sym. - - End generalized. - Definition identity (F : Functor C D) - : NaturalTransformation F F - := Eval simpl in @generalized_identity F F 1 1. - -End identity. -Module Export NaturalTransformationIdentityNotations. - - Notation "1" := (identity _) : natural_transformation_scope. -End NaturalTransformationIdentityNotations. -End Identity. - -Module Export Laws. -Import HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core.HoTT.categories. -Set Universe Polymorphism. - -Local Open Scope natural_transformation_scope. -Section natural_transformation_identity. - - Context `{fs : Funext}. - Variable C : PreCategory. - - Variable D : PreCategory. - - Lemma left_identity (F F' : Functor C D) - (T : NaturalTransformation F F') - : 1 o T = T. - - Proof. - path_natural_transformation; auto with morphism. - Qed. - - Lemma right_identity (F F' : Functor C D) - (T : NaturalTransformation F F') - : T o 1 = T. - - Proof. - path_natural_transformation; auto with morphism. - Qed. -End natural_transformation_identity. -Section associativity. - - Section nt. - - Context `{fs : Funext}. - Definition associativity - C D F G H I - (V : @NaturalTransformation C D F G) - (U : @NaturalTransformation C D G H) - (T : @NaturalTransformation C D H I) - : (T o U) o V = T o (U o V). - - Proof. - path_natural_transformation. - apply associativity. - Qed. - End nt. -End associativity. -End Laws. - -Module Export FunctorCategory. -Module Export Core. -Import HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core.HoTT.categories. -Set Universe Polymorphism. - -Section functor_category. - - Context `{Funext}. - Variable C : PreCategory. - - Variable D : PreCategory. - - Definition functor_category : PreCategory - := @Build_PreCategory (Functor C D) - (@NaturalTransformation C D) - (@identity C D) - (@compose C D) - (@associativity _ C D) - (@left_identity _ C D) - (@right_identity _ C D) - _. - -End functor_category. -Module Export FunctorCategoryCoreNotations. - - Notation "C -> D" := (functor_category C D) : category_scope. -End FunctorCategoryCoreNotations. -End Core. - -End FunctorCategory. - -Module Export Morphisms. -Set Universe Polymorphism. - -Set Implicit Arguments. - -Definition NaturalIsomorphism `{Funext} (C D : PreCategory) F G := - @Isomorphic (C -> D) F G. - -Module Export FunctorCategoryMorphismsNotations. - - Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. -End FunctorCategoryMorphismsNotations. -End Morphisms. - -Module Export HSet. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. - -Global Existing Instance iss. -End HSet. - -Module Export Core. -Set Universe Polymorphism. - -Notation cat_of obj := - (@Build_PreCategory obj - (fun x y => x -> y) - (fun _ x => x) - (fun _ _ _ f g => f o g)%core - (fun _ _ _ _ _ _ _ => idpath) - (fun _ _ _ => idpath) - (fun _ _ _ => idpath) - _). - -Definition set_cat `{Funext} : PreCategory := cat_of hSet. -Set Universe Polymorphism. - -Local Open Scope morphism_scope. - -Section hom_functor. - - Context `{Funext}. - Variable C : PreCategory. - Local Notation obj_of c'c := - (BuildhSet - (morphism - C - (fst (c'c : object (C^op * C))) - (snd (c'c : object (C^op * C)))) - _). - - Let hom_functor_morphism_of s's d'd (hf : morphism (C^op * C) s's d'd) - : morphism set_cat (obj_of s's) (obj_of d'd) - := fun g => snd hf o g o fst hf. - - Definition hom_functor : Functor (C^op * C) set_cat. - - refine (Build_Functor (C^op * C) set_cat - (fun c'c => obj_of c'c) - hom_functor_morphism_of - _ - _); - subst hom_functor_morphism_of; - simpl; admit. - Defined. -End hom_functor. -Set Universe Polymorphism. - -Import Category.Dual Functor.Dual. -Import Category.Prod Functor.Prod. -Import Functor.Composition.Core. -Import Functor.Identity. -Set Universe Polymorphism. - -Local Open Scope functor_scope. -Local Open Scope natural_transformation_scope. -Section Adjunction. - - Context `{Funext}. - Variable C : PreCategory. - Variable D : PreCategory. - Variable F : Functor C D. - Variable G : Functor D C. - - Let Adjunction_Type := - Eval simpl in (hom_functor D) o (F^op, 1) <~=~> (hom_functor C) o (1, G). - - Record AdjunctionHom := - { - mate_of : - @NaturalIsomorphism H - (Prod.prod (Category.Dual.opposite C) D) - (@set_cat H) - (@compose (Prod.prod (Category.Dual.opposite C) D) - (Prod.prod (Category.Dual.opposite D) D) - (@set_cat H) (@hom_functor H D) - (@pair (Category.Dual.opposite C) - (Category.Dual.opposite D) D D - (@opposite C D F) (identity D))) - (@compose (Prod.prod (Category.Dual.opposite C) D) - (Prod.prod (Category.Dual.opposite C) C) - (@set_cat H) (@hom_functor H C) - (@pair (Category.Dual.opposite C) - (Category.Dual.opposite C) D C - (identity (Category.Dual.opposite C)) G)) - }. -End Adjunction. -(* Error: Illegal application: -The term "NaturalIsomorphism" of type - "forall (H : Funext) (C D : PreCategory), - (C -> D)%category -> (C -> D)%category -> Type" -cannot be applied to the terms - "H" : "Funext" - "(C ^op * D)%category" : "PreCategory" - "set_cat" : "PreCategory" - "hom_functor D o (F ^op, 1)" : "Functor (C ^op * D) set_cat" - "hom_functor C o (1, G)" : "Functor (C ^op * D) set_cat" -The 5th term has type "Functor (C ^op * D) set_cat" -which should be coercible to "object (C ^op * D -> set_cat)". -*) -End Core. - -End HoTT. - -End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core. diff --git a/test-suite/bugs/closed/3331.v b/test-suite/bugs/closed/3331.v deleted file mode 100644 index b7dbb290e1..0000000000 --- a/test-suite/bugs/closed/3331.v +++ /dev/null @@ -1,31 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 6303 lines to 66 lines, then from 63 lines to 36 lines *) -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y :> A" := (@paths A x y) : type_scope. -Arguments idpath {A a} , [A] a. -Notation "x = y" := (x = y :>_) : type_scope. -Class Contr_internal (A : Type) := BuildContr { center : A ; contr : (forall y : A, center = y) }. -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. -Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. -Instance istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) : IsTrunc n (x = y) := H x y. -Notation Contr := (IsTrunc minus_two). -Section groupoid_category. - Variable X : Type. - Context `{H : IsTrunc (trunc_S (trunc_S (trunc_S minus_two))) X}. - Goal X -> True. - intro d. - pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))) as H'. (* success *) - clear H'. - compute in H. - change (forall (x y : X) (p q : x = y) (r s : p = q), Contr (r = s)) in H. - assert (H' := H). - set (foo:=_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). (* success *) - clear H' foo. - Set Typeclasses Debug. - pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). -Abort. diff --git a/test-suite/bugs/closed/3332.v b/test-suite/bugs/closed/3332.v deleted file mode 100644 index a3564bfcce..0000000000 --- a/test-suite/bugs/closed/3332.v +++ /dev/null @@ -1,6 +0,0 @@ -(* -*- coq-prog-args: ("-time") -*- *) -Definition foo : True. -Proof. -Abort. (* Toplevel input, characters 15-21: -Anomaly: Backtrack.backto to a state with no vcs_backup. Please report. *) -(* Anomaly: VernacAbort not handled by Stm. Please report. *) diff --git a/test-suite/bugs/closed/3336.v b/test-suite/bugs/closed/3336.v deleted file mode 100644 index dc358c6004..0000000000 --- a/test-suite/bugs/closed/3336.v +++ /dev/null @@ -1,9 +0,0 @@ -Require Import Setoid. - -Goal forall x y : Type, x = y -> x = y. -intros x y H. -setoid_rewrite H. -reflexivity. -Defined. -(* Toplevel input, characters 0-16: -Anomaly: Uncaught exception Reduction.NotConvertible(_). Please report. *) diff --git a/test-suite/bugs/closed/3337.v b/test-suite/bugs/closed/3337.v deleted file mode 100644 index cd7891f112..0000000000 --- a/test-suite/bugs/closed/3337.v +++ /dev/null @@ -1,4 +0,0 @@ -Require Import Setoid. -Goal forall x y : Set, x = y -> x = y. -intros x y H. -rewrite_strat subterms H. diff --git a/test-suite/bugs/closed/3338.v b/test-suite/bugs/closed/3338.v deleted file mode 100644 index 076cd5e6ea..0000000000 --- a/test-suite/bugs/closed/3338.v +++ /dev/null @@ -1,4 +0,0 @@ -Require Import Setoid. -Goal forall x y : Set, x = y -> y = y. -intros x y H. -rewrite_strat try topdown terms H. diff --git a/test-suite/bugs/closed/3344.v b/test-suite/bugs/closed/3344.v deleted file mode 100644 index 880851c565..0000000000 --- a/test-suite/bugs/closed/3344.v +++ /dev/null @@ -1,59 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 716 lines to 197 lines, then from 206 lines to 162 lines, then from 163 lines to 73 lines *) -Require Import Coq.Sets.Ensembles. -Require Import Coq.Strings.String. -Global Set Implicit Arguments. -Global Set Asymmetric Patterns. -Ltac clearbodies := repeat match goal with | [ H := _ |- _ ] => clearbody H end. - -Inductive Comp : Type -> Type := -| Return : forall A, A -> Comp A -| Bind : forall A B, Comp A -> (A -> Comp B) -> Comp B. -Inductive computes_to : forall A, Comp A -> A -> Prop := -| ReturnComputes : forall A v, @computes_to A (Return v) v -| BindComputes : forall A B comp_a f comp_a_value comp_b_value, - @computes_to A comp_a comp_a_value - -> @computes_to B (f comp_a_value) comp_b_value - -> @computes_to B (Bind comp_a f) comp_b_value. - -Inductive is_computational : forall A, Comp A -> Prop := -| Return_is_computational : forall A (x : A), is_computational (Return x) -| Bind_is_computational : forall A B (cA : Comp A) (f : A -> Comp B), - is_computational cA - -> (forall a, - @computes_to _ cA a -> is_computational (f a)) - -> is_computational (Bind cA f). -Theorem is_computational_inv A (c : Comp A) -: is_computational c - -> match c with - | Return _ _ => True - | Bind _ _ x f => is_computational x - /\ forall v, computes_to x v - -> is_computational (f v) - end. - admit. -Defined. -Fixpoint is_computational_unique_val A (c : Comp A) {struct c} -: is_computational c -> { a | unique (computes_to c) a }. -Proof. - refine match c as c return is_computational c -> { a | unique (computes_to c) a } with - | Return T x => fun _ => exist (unique (computes_to (Return x))) - x - _ - | Bind _ _ x f - => fun H - => let H' := is_computational_inv H in - let xv := @is_computational_unique_val _ _ (proj1 H') in - let fxv := @is_computational_unique_val _ _ (proj2 H' _ (proj1 (proj2_sig xv))) in - exist (unique (computes_to _)) - (proj1_sig fxv) - _ - end; - clearbodies; - clear is_computational_unique_val; - clear; - first [ abstract admit - | abstract admit ]. -(* [Fail] does not catch the anomaly *) -Defined. -(* Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/3346.v b/test-suite/bugs/closed/3346.v deleted file mode 100644 index 09bd789345..0000000000 --- a/test-suite/bugs/closed/3346.v +++ /dev/null @@ -1,4 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) -Monomorphic Inductive paths (A : Type) (a : A) : A -> Type := idpath : paths A a a. -(* This should fail with -indices-matter *) -Fail Check paths nat O O : Prop. diff --git a/test-suite/bugs/closed/3347.v b/test-suite/bugs/closed/3347.v deleted file mode 100644 index dcf5394eaf..0000000000 --- a/test-suite/bugs/closed/3347.v +++ /dev/null @@ -1,40 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 12653 lines to 12453 lines, then from 11673 lines to 681 lines, then from 693 lines to 469 lines, then from 375 lines to 56 lines *) -Set Universe Polymorphism. -Notation Type1 := ltac:(let U := constr:(Type) in let gt := constr:(Set : U) in exact U) (only parsing). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Inductive Unit : Type1 := tt : Unit. -Fail Check Unit : Set. (* [Check Unit : Set] should fail if [Type1] is defined correctly *) -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Record Functor (C D : PreCategory) := { object_of :> C -> D }. -Definition indiscrete_category X : PreCategory := @Build_PreCategory X (fun _ _ => Unit). -Definition from_terminal (C : PreCategory) one (c : C) := Build_Functor one C (fun _ => c). -Local Notation "! x" := (from_terminal _ (indiscrete_category Unit) x) (at level 3). -Record NaturalTransformation {C D} (F G : Functor C D) := - { components_of :> forall c, morphism D (F c) (G c); - commutes : forall c, components_of c = components_of c }. -Definition slice_category_induced_functor_nt (D : PreCategory) s d (m : morphism D s d) -: NaturalTransformation !s !d. -Proof. - exists (fun _ : Unit => m); - simpl; intros; clear; - abstract admit. -Defined. -(* Toplevel input, characters 15-23: -Error: Illegal application: -The term "Build_NaturalTransformation" of type - "forall (C D : PreCategory) (F G : Functor C D) - (components_of : forall c : C, morphism D (F c) (G c)), - (forall c : C, components_of c = components_of c) -> - NaturalTransformation F G" -cannot be applied to the terms - "indiscrete_category Unit" : "PreCategory" - "D" : "PreCategory" - "! s" : "Functor (indiscrete_category Unit) D" - "! d" : "Functor (indiscrete_category Unit) D" - "fun _ : Unit => m" : "Unit -> morphism D s d" - "fun _ : Unit => slice_category_induced_functor_nt_subproof D s d m" - : "forall c : indiscrete_category Unit, m = m" -The 5th term has type "Unit -> morphism D s d" which should be coercible to - "forall c : indiscrete_category Unit, morphism D (! s c) (! d c)". - *) diff --git a/test-suite/bugs/closed/3348.v b/test-suite/bugs/closed/3348.v deleted file mode 100644 index 904de68964..0000000000 --- a/test-suite/bugs/closed/3348.v +++ /dev/null @@ -1,6 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) -Set Universe Polymorphism. -Set Printing Universes. -Inductive Empty : Set := . -(* Toplevel input, characters 15-41: -Error: Universe inconsistency. Cannot enforce Prop <= Set). *) diff --git a/test-suite/bugs/closed/3350.v b/test-suite/bugs/closed/3350.v deleted file mode 100644 index c1ff292b3e..0000000000 --- a/test-suite/bugs/closed/3350.v +++ /dev/null @@ -1,121 +0,0 @@ -Require Import TestSuite.admit. -Require Coq.Vectors.Fin. -Require Coq.Vectors.Vector. - -Local Generalizable All Variables. -Set Implicit Arguments. - -Arguments Fin.F1 : clear implicits. - -Lemma fin_0_absurd : notT (Fin.t 0). -Proof. hnf. apply Fin.case0. Qed. - -Axiom admit : forall {A}, A. - -Fixpoint lower {n:nat} (p:Fin.t (S n)) {struct p} : - forall (i:Fin.t (S n)), option (Fin.t n) - := match p in Fin.t (S n1) - return Fin.t (S n1) -> option (Fin.t n1) - with - | @Fin.F1 n1 => - fun (i:Fin.t (S n1)) => - match i in Fin.t (S n2) return option (Fin.t n2) with - | @Fin.F1 n2 => None - | @Fin.FS n2 i2 => Some i2 - end - | @Fin.FS n1 p1 => - fun (i:Fin.t (S n1)) => - match i in Fin.t (S n2) return Fin.t n2 -> option (Fin.t n2) with - | @Fin.F1 n2 => - match n2 as n3 return Fin.t n3 -> option (Fin.t n3) with - | 0 => fun p2 => False_rect _ (fin_0_absurd p2) - | S n3 => fun p2 => Some (Fin.F1 n3) - end - | @Fin.FS n2 i2 => - match n2 as n3 return Fin.t n3 -> Fin.t n3 -> option (Fin.t n3) with - | 0 => fun i3 p3 => False_rect _ (fin_0_absurd p3) - | S n3 => fun (i3 p3:Fin.t (S n3)) => - option_map (@Fin.FS _) admit - end i2 - end p1 - end. - -Lemma lower_ind (P: forall n (p i:Fin.t (S n)), option (Fin.t n) -> Prop) - (c11 : forall n, P n (Fin.F1 n) (Fin.F1 n) None) - (c1S : forall n (i:Fin.t n), P n (Fin.F1 n) (Fin.FS i) (Some i)) - (cS1 : forall n (p:Fin.t (S n)), - P (S n) (Fin.FS p) (Fin.F1 (S n)) (Some (Fin.F1 n))) - (cSSS : forall n (p i:Fin.t (S n)) (i':Fin.t n) - (Elow:lower p i = Some i'), - P n p i (Some i') -> - P (S n) (Fin.FS p) (Fin.FS i) (Some (Fin.FS i'))) - (cSSN : forall n (p i:Fin.t (S n)) - (Elow:lower p i = None), - P n p i None -> - P (S n) (Fin.FS p) (Fin.FS i) None) : - forall n (p i:Fin.t (S n)), P n p i (lower p i). -Proof. - fix lower_ind 2. intros n p. - refine (match p as p1 in Fin.t (S n1) - return forall (i1:Fin.t (S n1)), P n1 p1 i1 (lower p1 i1) - with - | @Fin.F1 n1 => _ - | @Fin.FS n1 p1 => _ - end); clear n p. - { revert n1. refine (@Fin.caseS _ _ _); cbn; intros. - apply c11. apply c1S. } - { intros i1. revert p1. - pattern n1, i1; refine (@Fin.caseS _ _ _ _ _); - clear n1 i1; - (intros [|n] i; [refine (False_rect _ (fin_0_absurd i)) | cbn ]). - { apply cS1. } - { intros p. pose proof (admit : P n p i (lower p i)) as H. - destruct (lower p i) eqn:E. - { admit; assumption. } - { cbn. apply admit; assumption. } } } -Qed. - -Section squeeze. - Context {A:Type} (x:A). - Notation vec := (Vector.t A). - - Fixpoint squeeze {n} (v:vec n) (i:Fin.t (S n)) {struct i} : vec (S n) := - match i in Fin.t (S _n) return vec _n -> vec (S _n) - with - | @Fin.F1 n' => fun v' => Vector.cons _ x _ v' - | @Fin.FS n' i' => - fun v' => - match n' as _n return vec _n -> Fin.t _n -> vec (S _n) - with - | 0 => fun u i' => False_rect _ (fin_0_absurd i') - | S m => - fun (u:vec (S m)) => - match u in Vector.t _ (S _m) - return Fin.t (S _m) -> vec (S (S _m)) - with - | Vector.nil _ => tt - | Vector.cons _ h _ u' => - fun j' => Vector.cons _ h _ admit (* (squeeze u' j') *) - end - end v' i' - end v. -End squeeze. - -Require Import Program. -Lemma squeeze_nth (A:Type) (x:A) (n:nat) (v:Vector.t A n) p i : - Vector.nth (squeeze x v p) i = match lower p i with - | Some j => Vector.nth v j - | None => x - end. -Proof. - (* alternatively: [functional induction (lower p i) using lower_ind] *) - revert v. pattern n, p, i, (lower p i). - refine (@lower_ind _ _ _ _ _ _ n p i); - intros; cbn; auto. - - (*** Fails here with "Conversion test raised an anomaly" ***) - revert v. - admit. - admit. - admit. -Qed. diff --git a/test-suite/bugs/closed/3352.v b/test-suite/bugs/closed/3352.v deleted file mode 100644 index bf2f7a9d19..0000000000 --- a/test-suite/bugs/closed/3352.v +++ /dev/null @@ -1,35 +0,0 @@ -Unset Strict Universe Declaration. - -(* -I'm not sure what the general rule should be; intuitively, I want [IsHProp (* Set *) Foo] to mean [IsHProp (* U >= Set *) Foo]. (I think this worked in HoTT/coq, too.) Morally, [IsHProp] has no universe level associated with it distinct from that of its argument, you should never get a universe inconsistency from unifying [IsHProp A] with [IsHProp A]. (The issue is tricker when IsHProp uses [A] elsewhere, as in: -*) - -(* File reduced by coq-bug-finder from original input, then from 7725 lines to 78 lines, then from 51 lines to 13 lines *) -Set Universe Polymorphism. -Inductive Empty : Set := . -Record IsHProp (A : Type) := { foo : True }. -Definition hprop_Empty : IsHProp@{i} Empty := {| foo := I |}. -Goal let U := Type in let gt := Set : U in IsHProp (Empty : U). -simpl. -Set Printing Universes. -exact @hprop_Empty. (* Toplevel input, characters 21-32: -Error: -The term "hprop_Empty" has type "IsHProp (* Set *) Empty" -while it is expected to have type "IsHProp (* Top.17 *) Empty" -(Universe inconsistency: Cannot enforce Top.17 = Set because Set < Top.17)). *) -Defined. - -Module B. -(* -*- coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 7725 lines to 78 lines, then from 51 lines to 13 lines *) -Set Universe Polymorphism. -Inductive paths {A} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Record Contr (A : Type) := { center : A }. -Monomorphic Record IsHProp (A : Type) := { foo : forall x y : A, Contr (x = y) }. -Definition hprop_Empty : IsHProp Empty := {| foo x y := match x : Empty with end |}. -Goal let U := Type in let gt := Set : U in IsHProp (Empty : U). -simpl. -Set Printing Universes. -exact hprop_Empty. -Defined. -End B. diff --git a/test-suite/bugs/closed/3354.v b/test-suite/bugs/closed/3354.v deleted file mode 100644 index a635285f2c..0000000000 --- a/test-suite/bugs/closed/3354.v +++ /dev/null @@ -1,12 +0,0 @@ -Set Universe Polymorphism. -Notation Type1 := ltac:(let U := constr:(Type) in let gt := constr:(Set : U) in exact U) (only parsing). -Inductive Empty : Type1 := . -Fail Check Empty : Set. -(* Toplevel input, characters 15-116: -Error: Conversion test raised an anomaly *) -(* Now we make sure it's not an anomaly *) -Goal True. -Proof. - try exact (let x := Empty : Set in I). - exact I. -Defined. diff --git a/test-suite/bugs/closed/3355.v b/test-suite/bugs/closed/3355.v deleted file mode 100644 index 46a5714781..0000000000 --- a/test-suite/bugs/closed/3355.v +++ /dev/null @@ -1,6 +0,0 @@ -Inductive paths {A} (x : A) : A -> Type := idpath : paths x x. -Goal forall A B : Set, @paths Type A B -> @paths Set A B. -Proof. - intros A B H. - Fail exact H. -Abort. diff --git a/test-suite/bugs/closed/3368.v b/test-suite/bugs/closed/3368.v deleted file mode 100644 index 1eff1dba8a..0000000000 --- a/test-suite/bugs/closed/3368.v +++ /dev/null @@ -1,16 +0,0 @@ -(* File reduced by coq-bug-finder from 7411 lines to 2271 lines., then from 889 lines to 119 lines, then from 76 lines to 19 lines *) -Set Universe Polymorphism. -Set Implicit Arguments. -Set Primitive Projections. -Record PreCategory := { object :> Type; morphism : object -> object -> Type }. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. -Definition opposite (C : PreCategory) : PreCategory := @Build_PreCategory C (fun s d => morphism C d s). -Definition opposite' C D (F : Functor C D) - := Build_Functor (opposite C) (opposite D) - (object_of F) - (fun s d => @morphism_of C D F d s). -(* Toplevel input, characters 15-191: -Anomaly: File "pretyping/reductionops.ml", line 149, characters 4-10: Assertion failed. -Please report. *) diff --git a/test-suite/bugs/closed/3372.v b/test-suite/bugs/closed/3372.v deleted file mode 100644 index 91e3df76dd..0000000000 --- a/test-suite/bugs/closed/3372.v +++ /dev/null @@ -1,7 +0,0 @@ -Set Universe Polymorphism. -Definition hProp : Type := sigT (fun _ : Type => True). -Goal Type. -Fail exact hProp@{Set}. (* test that it fails, but is not an anomaly *) -try (exact hProp@{Set}; fail 1). (* Toplevel input, characters 15-32: -Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). -Please report. *) diff --git a/test-suite/bugs/closed/3373.v b/test-suite/bugs/closed/3373.v deleted file mode 100644 index 051e695203..0000000000 --- a/test-suite/bugs/closed/3373.v +++ /dev/null @@ -1,34 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 5968 lines to -11933 lines, then from 11239 lines to 11231 lines, then from 10365 lines to 446 -lines, then from 456 lines to 379 lines, then from 391 lines to 373 lines, then -from 369 lines to 351 lines, then from 350 lines to 340 lines, then from 348 -lines to 320 lines, then from 328 lines to 302 lines, then from 332 lines to 21 -lines *) -Set Universe Polymorphism. -Module short. - Record foo := { bar : Type }. - Coercion baz (x : foo@{Set}) : Set := bar x. - Goal True. - Proof. - Fail pose ({| bar := Set |} : Type). (* check that it fails *) - try pose ({| bar := Set |} : Type). (* Anomaly: apply_coercion_args: mismatch between arguments and coercion. -Please report. *) - Admitted. -End short. - -Module long. - Axiom admit : forall {T}, T. - Definition UU := Set. - Definition UU' := Type. - Definition hSet:= sigT (fun X : UU' => admit) . - Definition pr1hSet:= @projT1 UU (fun X : UU' => admit) : hSet -> Type. - Coercion pr1hSet: hSet >-> Sortclass. - Axiom binop : UU -> Type. - Axiom setwithbinop : Type. - Goal True. - Proof. - Fail pose (( @projT1 _ ( fun X : hSet@{i j k} => binop X ) ) : _ -> hSet). (* check that it fails *) - try pose (( @projT1 _ ( fun X : hSet@{i j k} => binop X ) ) : _ -> hSet). (* check that it's not an anomaly *) - Admitted. -End long. diff --git a/test-suite/bugs/closed/3374.v b/test-suite/bugs/closed/3374.v deleted file mode 100644 index d8e72f4f20..0000000000 --- a/test-suite/bugs/closed/3374.v +++ /dev/null @@ -1,52 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 5968 lines to 11933 lines, then from 11239 lines to 11231 lines, then from 10365 lines to 446 lines, then from 456 lines to 379 lines, then from 391 lines to 373 lines, then from 369 lines to 351 lines, then from 350 lines to 340 lines, then from 348 lines to 320 lines, then from 328 lines to 302 lines, then from 331 lines to 59 lines *) - -Set Universe Polymorphism. -Axiom admit : forall {T}, T. -Notation paths := identity . -Definition UU := Set. -Definition dirprod ( X Y : UU ) := sigT ( fun x : X => Y ) . -Definition dirprodpair { X Y : UU } := existT ( fun x : X => Y ) . -Definition hProp := sigT (fun X : Type => admit). -Definition hProptoType := @projT1 _ _ : hProp -> Type . -Coercion hProptoType: hProp >-> Sortclass. -Definition UU' := Type. -Definition hSet:= sigT (fun X : UU' => admit) . -Definition pr1hSet:= @projT1 UU (fun X : UU' => admit) : hSet -> Type. -Coercion pr1hSet: hSet >-> Sortclass. -Axiom hsubtypes : UU -> Type. -Definition hrel ( X : UU ) := X -> X -> hProp. -Axiom hreldirprod : forall { X Y : UU } ( RX : hrel X ) ( RY : hrel Y ), hrel ( dirprod X Y ) . -Axiom iseqclass : forall { X : UU } ( R : hrel X ) ( A : hsubtypes X ), Type. -Definition setquot { X : UU } ( R : hrel X ) : Type := sigT (fun A => iseqclass R A). -Axiom dirprodtosetquot : forall { X Y : UU } ( RX : hrel X ) ( RY : hrel Y ) (cd : dirprod ( setquot RX ) ( setquot RY ) ), - setquot ( hreldirprod RX RY ). -Definition iscomprelfun2 { X Y : UU } ( R : hrel X ) ( f : X -> X -> Y ) - := forall x x' x0 x0' : X , R x x' -> R x0 x0' -> paths ( f x x0 ) ( f x' x0' ) . -Axiom setquotuniv : forall { X : UU } ( R : hrel X ) ( Y : hSet ) ( f : X -> Y ) ( c : setquot R ), Y . -Definition setquotuniv2 { X : UU } ( R : hrel X ) ( Y : hSet ) ( f : X -> X -> Y ) ( is : iscomprelfun2 R f ) ( c c0 : setquot R ) -: Y . -Proof. - intros . - set ( RR := hreldirprod R R ) . - apply (setquotuniv RR Y admit). - apply (dirprodtosetquot R R). - apply dirprodpair; [ exact c | exact c0 ]. - Undo. - exact (dirprodpair c c0). -Defined. - (* Toplevel input, characters 39-40: -Error: -In environment -X : UU -R : hrel X -Y : hSet -f : X -> X -> Y -is : iscomprelfun2 R f -c : setquot R -c0 : setquot R -RR := hreldirprod R R : hrel (dirprod X X) -The term "c" has type "setquot R" while it is expected to have type -"?42" (unable to find a well-typed instantiation for -"?42": cannot unify"Type" and "UU"). - *) diff --git a/test-suite/bugs/closed/3375.v b/test-suite/bugs/closed/3375.v deleted file mode 100644 index 1e0c8e61f4..0000000000 --- a/test-suite/bugs/closed/3375.v +++ /dev/null @@ -1,49 +0,0 @@ -Require Import TestSuite.admit. -(* -*- mode: coq; coq-prog-args: ("-impredicative-set") -*- *) -(* File reduced by coq-bug-finder from original input, then from 5968 lines to 11933 lines, then from 11239 lines to 11231 lines, then from 10365 lines to 446 lines, then from 456 lines to 379 lines, then from 391 lines to 373 lines, then from 369 lines to 351 lines, then from 350 lines to 340 lines, then from 348 lines to 320 lines, then from 328 lines to 302 lines, then from 330 lines to 45 lines *) - -Set Universe Polymorphism. -Axiom admit : forall {T}, T. -Definition UU := Set. -Definition dirprod ( X Y : UU ) := sigT ( fun x : X => Y ) . -Definition dirprodpair { X Y : UU } := existT ( fun x : X => Y ) . -Definition hProp := sigT (fun X : Type => admit). -Axiom hProppair : forall ( X : UU ) ( is : admit ), hProp. -Definition hProptoType := @projT1 _ _ : hProp -> Type . -Coercion hProptoType: hProp >-> Sortclass. -Definition ishinh_UU ( X : UU ) : UU := forall P: Set, ( ( X -> P ) -> P ). -Definition ishinh ( X : UU ) : hProp := hProppair ( ishinh_UU X ) admit. -Definition hsubtypes ( X : UU ) : Type := X -> hProp. -Axiom carrier : forall { X : UU } ( A : hsubtypes X ), Type. -Definition hrel ( X : UU ) : Type := X -> X -> hProp. -Set Printing Universes. -Definition iseqclass { X : UU } ( R : hrel X ) ( A : hsubtypes X ) : Type. - intros; exact ( dirprod ( ishinh ( carrier A ) ) ( dirprod ( forall x1 x2 : X , R x1 x2 -> A x1 -> A x2 ) - ( forall x1 x2 : X, A x1 -> A x2 -> R x1 x2 ) )) . -Defined. -Definition iseqclassconstr' { X : UU } ( R : hrel X ) { A : hsubtypes X } ( ax0 : ishinh ( carrier A ) ) - ( ax1 : forall x1 x2 : X , R x1 x2 -> A x1 -> A x2 ) ( ax2 : forall x1 x2 : X, A x1 -> A x2 -> R x1 x2 ) : iseqclass R A. - intros. - apply dirprodpair. { exact ax0. } - apply dirprodpair. { exact ax1. } {exact ax2. } -Defined. -Definition iseqclassconstr { X : UU } ( R : hrel X ) { A : hsubtypes X } ( ax0 : ishinh ( carrier A ) ) - ( ax1 : forall x1 x2 : X , R x1 x2 -> A x1 -> A x2 ) ( ax2 : forall x1 x2 : X, A x1 -> A x2 -> R x1 x2 ) : iseqclass R A. - pose @iseqclassconstr'. - intros. - exact (dirprodpair ax0 (dirprodpair ax1 ax2)). -Defined. -(* Toplevel input, characters 15-23: -Error: Illegal application: -The term "dirprodpair" of type - "forall (X Y : UU) (x : X), (fun _ : X => Y) x -> {_ : X & Y}" -cannot be applied to the terms - "forall x1 x2 : X, R x1 x2 -> A x1 -> A x2" - : "Type@{max(Set, Top.476, Top.479)}" - "forall x1 x2 : X, A x1 -> A x2 -> R x1 x2" - : "Type@{max(Set, Top.476, Top.479)}" - "ax1" : "forall x1 x2 : X, R x1 x2 -> A x1 -> A x2" - "ax2" : "forall x1 x2 : X, A x1 -> A x2 -> R x1 x2" -The 1st term has type "Type@{max(Set, Top.476, Top.479)}" -which should be coercible to "UU". - *) diff --git a/test-suite/bugs/closed/3377.v b/test-suite/bugs/closed/3377.v deleted file mode 100644 index abfcf1d355..0000000000 --- a/test-suite/bugs/closed/3377.v +++ /dev/null @@ -1,18 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. -Record prod A B := pair { fst : A; snd : B}. - -Goal fst (@pair Type Type Type Type). -Set Printing All. -match goal with |- ?f ?x => set (foo := f x) end. -Abort. - -Goal forall x : prod Set Set, x = @pair _ _ (fst x) (snd x). -Proof. - intro x. - lazymatch goal with - | [ |- ?x = @pair _ _ (?f ?x) (?g ?x) ] => pose f - end. -(* Toplevel input, characters 7-44: -Error: No matching clauses for match. *) -Abort. diff --git a/test-suite/bugs/closed/3382.v b/test-suite/bugs/closed/3382.v deleted file mode 100644 index 3e374d9077..0000000000 --- a/test-suite/bugs/closed/3382.v +++ /dev/null @@ -1,64 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from 9039 lines to 7786 lines, then from 7245 lines to 476 lines, then from 417 lines to 249 lines, then from 171 lines to 127 lines, then from 139 lines to 114 lines, then from 93 lines to 77 lines *) - -Set Implicit Arguments. -Definition admit {T} : T. -Admitted. -Delimit Scope object_scope with object. -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope functor_scope with functor. -Reserved Infix "o" (at level 40, left associativity). -Record PreCategory := - { Object :> Type; - Morphism : Object -> Object -> Type; - Compose : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' where "f 'o' g" := (Compose f g) }. -Bind Scope category_scope with PreCategory. -Infix "o" := (@Compose _ _ _ _) : morphism_scope. -Local Open Scope morphism_scope. -Record Functor (C D : PreCategory) := - { ObjectOf :> C -> D; - MorphismOf : forall s d, C.(Morphism) s d -> D.(Morphism) (ObjectOf s) (ObjectOf d); - FCompositionOf : forall s d d' (m1 : C.(Morphism) s d) (m2: C.(Morphism) d d'), - MorphismOf _ _ (m2 o m1) = (MorphismOf _ _ m2) o (MorphismOf _ _ m1) }. -Bind Scope functor_scope with Functor. -Arguments MorphismOf [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. -Definition ComposeFunctors C D E - (G : Functor D E) (F : Functor C D) : Functor C E - := Build_Functor C E (fun c => G (F c)) admit admit. -Infix "o" := ComposeFunctors : functor_scope. -Record NaturalTransformation C D (F G : Functor C D) := - { ComponentsOf :> forall c, D.(Morphism) (F c) (G c); - Commutes : forall s d (m : C.(Morphism) s d), - ComponentsOf d o F.(MorphismOf) m = G.(MorphismOf) m o ComponentsOf s }. -Definition NTComposeT C D (F F' F'' : Functor C D) - (T' : NaturalTransformation F' F'') - (T : NaturalTransformation F F') - (CO := fun c => T' c o T c) -: NaturalTransformation F F''. - exact (Build_NaturalTransformation F F'' - (fun c => T' c o T c) - (admit : forall s d (m : Morphism C s d), CO d o MorphismOf F m = MorphismOf F'' m o CO s)). -Defined. -Definition NTWhiskerR C D E (F F' : Functor D E) (T : NaturalTransformation F F') - (G : Functor C D) - := Build_NaturalTransformation (F o G) (F' o G) (fun c => T (G c)) admit. -Axiom NTWhiskerR_CompositionOf -: forall C D - (F G H : Functor C D) - (T : NaturalTransformation G H) - (T' : NaturalTransformation F G) B (I : Functor B C), - NTComposeT (NTWhiskerR T I) (NTWhiskerR T' I) = NTWhiskerR (NTComposeT T T') I. -Definition FunctorCategory C D : PreCategory - := @Build_PreCategory (Functor C D) - (NaturalTransformation (C := C) (D := D)) - admit. -Notation "[ C , D ]" := (FunctorCategory C D) : category_scope. -Class silly {T} := term : T. -Timeout 1 Fail Definition NTWhiskerR_Functorial (C D E : PreCategory) (G : [C, D]%category) -: [[D, E], [C, E]]%category - := Build_Functor - [C, D] [C, E] - (fun F => _ : silly) - (fun _ _ T => _ : silly) - (fun _ _ _ _ _ => NTWhiskerR_CompositionOf _ _ _). diff --git a/test-suite/bugs/closed/3383.v b/test-suite/bugs/closed/3383.v deleted file mode 100644 index 25257644a6..0000000000 --- a/test-suite/bugs/closed/3383.v +++ /dev/null @@ -1,6 +0,0 @@ -Goal forall b : bool, match b as b' return if b' then True else True with true => I | false => I end = match b as b' return if b' then True else True with true => I | false => I end. -intro. -lazymatch goal with -| [ |- context[match ?b as b' in bool return @?P b' with true => ?t | false => ?f end] ] - => change (match b as b' in bool return P b' with true => t | false => f end) with (@bool_rect P t f b) -end. diff --git a/test-suite/bugs/closed/3386.v b/test-suite/bugs/closed/3386.v deleted file mode 100644 index b8bb8bce09..0000000000 --- a/test-suite/bugs/closed/3386.v +++ /dev/null @@ -1,17 +0,0 @@ -Unset Strict Universe Declaration. -Set Universe Polymorphism. -Set Printing Universes. -Record Cat := { Obj :> Type }. -Definition set_cat := {| Obj := Type |}. -Goal Type@{i} = Type@{j}. -Proof. - (* 1 subgoals -, subgoal 1 (ID 3) - - ============================ - Type@{Top.368} = Type@{Top.370} -(dependent evars:) *) - Fail change Type@{i} with (Obj set_cat@{i}). (* check that it fails *) - try change Type@{i} with (Obj set_cat@{i}). (* check that it's not an anomaly *) -(* Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). -Please report. *) diff --git a/test-suite/bugs/closed/3387.v b/test-suite/bugs/closed/3387.v deleted file mode 100644 index 1d9e783374..0000000000 --- a/test-suite/bugs/closed/3387.v +++ /dev/null @@ -1,22 +0,0 @@ -Unset Strict Universe Declaration. -Set Universe Polymorphism. -Set Printing Universes. -Record Cat := { Obj :> Type }. -Definition set_cat := {| Obj := Type |}. -Goal Type@{i} = Type@{j}. -Proof. - (* 1 subgoals -, subgoal 1 (ID 3) - - ============================ - Type@{Top.368} = Type@{Top.370} -(dependent evars:) *) - let x := constr:(Type) in - let y := constr:(Obj set_cat) in - unify x y. (* success *) - let x := constr:(Type) in - let y := constr:(Obj set_cat) in - first [ unify x y | fail 2 "no unify" ]; - change x with y at -1. (* Error: Not convertible. *) - reflexivity. -Defined. diff --git a/test-suite/bugs/closed/3388.v b/test-suite/bugs/closed/3388.v deleted file mode 100644 index 7826280498..0000000000 --- a/test-suite/bugs/closed/3388.v +++ /dev/null @@ -1,57 +0,0 @@ -Inductive test : bool -> bool -> Type := -| test00 : test false false -| test01 : test false true -| test10 : test true false -. - -(* This does not work *) -Definition test_a (t : test true false) : test true false := - match t with - | test10 => test10 - end. - -(* The following definition shows that test_a SHOULD work *) -Definition test_a_workaround (t : test true false) : test true false := - match t with - | test10 => test10 - | _ => tt - end. - -(* Surprisingly, this works *) -Definition test_b (t : test false true) : test false true := - match t with - | test01 => test01 - end. - - -(* This, too, works *) -Definition test_c x (t : test false x) : test false x := - match t with - | test00 => test00 - | test01 => test01 - end. - -Inductive test2 : bool -> bool -> Type := -| test201 : test2 false true -| test210 : test2 true false -| test211 : test2 true true -. - -(* Now this works *) -Definition test2_a (t : test2 true false) : test2 true false := - match t with - | test210 => test210 - end. - -(* Accordingly, this now fails *) -Definition test2_b (t : test2 false true) : test2 false true := - match t with - | test201 => test201 - end. - - -(* This, too, fails *) -Definition test2_c x (t : test2 false x) : test2 false x := - match t with - | test201 => test201 - end. diff --git a/test-suite/bugs/closed/3390.v b/test-suite/bugs/closed/3390.v deleted file mode 100644 index eb3c4f4b9c..0000000000 --- a/test-suite/bugs/closed/3390.v +++ /dev/null @@ -1,9 +0,0 @@ -Tactic Notation "basicapply" open_constr(R) "using" tactic3(tac) "sideconditions" tactic0(tacfin) := idtac. -Tactic Notation "basicapply" open_constr(R) := basicapply R using (fun Hlem => idtac) sideconditions (autounfold with spred; idtac). -(* segfault in coqtop *) - - -Tactic Notation "basicapply" tactic0(tacfin) := idtac. - -Goal True. -basicapply subst. diff --git a/test-suite/bugs/closed/3392.v b/test-suite/bugs/closed/3392.v deleted file mode 100644 index a03db77544..0000000000 --- a/test-suite/bugs/closed/3392.v +++ /dev/null @@ -1,40 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 12105 lines to 142 lines, then from 83 lines to 57 lines *) -Generalizable All Variables. -Axiom admit : forall {T}, T. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. -Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): transport _ p (f x) = f y := admit. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) }. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3). -Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), (forall x, f x = g x) -> f = g. -Axiom isequiv_adjointify : forall {A B} (f : A -> B) (g : B -> A) (isretr : Sect g f) (issect : Sect f g), IsEquiv f. -Definition functor_forall `{P : A -> Type} `{Q : B -> Type} (f0 : B -> A) (f1 : forall b:B, P (f0 b) -> Q b) -: (forall a:A, P a) -> (forall b:B, Q b) := (fun g b => f1 _ (g (f0 b))). -Goal forall `{P : A -> Type} `{Q : B -> Type} `{IsEquiv B A f} `{forall b, @IsEquiv (P (f b)) (Q b) (g b)}, - IsEquiv (functor_forall f g). -Proof. - intros. - refine (isequiv_adjointify (functor_forall f g) - (functor_forall (f^-1) - (fun (x:A) (y:Q (f^-1 x)) => @eisretr _ _ f H x # (g (f^-1 x))^-1 y - )) _ _); intros h. - - abstract ( - apply path_forall; intros b; unfold functor_forall; - rewrite eisadj; - admit - ). - - abstract ( - apply path_forall; intros a; unfold functor_forall; - rewrite eissect; - apply apD - ). -Defined. diff --git a/test-suite/bugs/closed/3393.v b/test-suite/bugs/closed/3393.v deleted file mode 100644 index ae8e41e29e..0000000000 --- a/test-suite/bugs/closed/3393.v +++ /dev/null @@ -1,153 +0,0 @@ -Require Import TestSuite.admit. -(* -*- coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 8760 lines to 7519 lines, then from 7050 lines to 909 lines, then from 846 lines to 578 lines, then from 497 lines to 392 lines, then from 365 lines to 322 lines, then from 252 lines to 205 lines, then from 215 lines to 204 lines, then from 210 lines to 182 lines, then from 175 lines to 157 lines *) -Set Universe Polymorphism. -Axiom admit : forall {T}, T. -Set Implicit Arguments. -Generalizable All Variables. -Reserved Notation "g 'o' f" (at level 40, left associativity). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "a = b" := (@paths _ a b) : type_scope. -Arguments idpath {A a} , [A] a. -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) : forall x, f x = g x := fun x => match h with idpath => idpath end. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A }. -Delimit Scope equiv_scope with equiv. -Local Open Scope equiv_scope. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. -Class Funext := { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. -Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x) : (forall x, f x = g x) -> f = g := (@apD10 A P f g)^-1. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - compose : forall s d d', morphism d d' -> morphism s d -> morphism s d' where "f 'o' g" := (compose f g); - associativity : forall x1 x2 x3 x4 (m1 : morphism x1 x2) (m2 : morphism x2 x3) (m3 : morphism x3 x4), (m3 o m2) o m1 = m3 o (m2 o m1) - }. -Bind Scope category_scope with PreCategory. -Bind Scope morphism_scope with morphism. -Infix "o" := (@compose _ _ _ _) : morphism_scope. -Delimit Scope functor_scope with functor. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. -Bind Scope functor_scope with Functor. -Notation "F '_1' m" := (@morphism_of _ _ F _ _ m) (at level 10, no associativity) : morphism_scope. -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. -Local Notation "m ^-1" := (morphism_inverse (m := m)) : morphism_scope. -Class Isomorphic {C : PreCategory} s d := - { morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. -Coercion morphism_isomorphic : Isomorphic >-> morphism. -Definition isisomorphism_inverse `(@IsIsomorphism C x y m) : IsIsomorphism m^-1 := {| morphism_inverse := m |}. - -Global Instance isisomorphism_compose `(@IsIsomorphism C y z m0) `(@IsIsomorphism C x y m1) : IsIsomorphism (m0 o m1). -Admitted. -Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. -Definition composef C D E (G : Functor D E) (F : Functor C D) : Functor C E - := Build_Functor - C E - (fun c => G (F c)) - (fun _ _ m => @morphism_of _ _ G _ _ (@morphism_of _ _ F _ _ m)). -Infix "o" := composef : functor_scope. -Delimit Scope natural_transformation_scope with natural_transformation. - -Local Open Scope morphism_scope. -Record NaturalTransformation C D (F G : Functor C D) := - { components_of :> forall c, morphism D (F c) (G c); - commutes : forall s d (m : morphism C s d), components_of d o F _1 m = G _1 m o components_of s }. - -Definition composet C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F') -: NaturalTransformation F F'' - := Build_NaturalTransformation F F'' (fun c => T' c o T c) admit. -Infix "o" := composet : natural_transformation_scope. -Section path_natural_transformation. - Context `{Funext}. - Variable C : PreCategory. - Variable D : PreCategory. - Variables F G : Functor C D. - Section path. - Variables T U : NaturalTransformation F G. - Lemma path'_natural_transformation - : components_of T = components_of U - -> T = U. - admit. - Defined. - Lemma path_natural_transformation - : (forall x, components_of T x = components_of U x) - -> T = U. - Proof. - intros. - apply path'_natural_transformation. - apply path_forall; assumption. - Qed. - End path. -End path_natural_transformation. -Ltac path_natural_transformation := - repeat match goal with - | _ => intro - | _ => apply path_natural_transformation; simpl - end. - -Local Open Scope natural_transformation_scope. -Definition associativityt `{fs : Funext} - C D F G H I - (V : @NaturalTransformation C D F G) - (U : @NaturalTransformation C D G H) - (T : @NaturalTransformation C D H I) -: (T o U) o V = T o (U o V). -Proof. - path_natural_transformation. - apply associativity. -Qed. -Definition functor_category `{Funext} (C D : PreCategory) : PreCategory - := @Build_PreCategory (Functor C D) (@NaturalTransformation C D) (@composet C D) (@associativityt _ C D). -Notation "C -> D" := (functor_category C D) : category_scope. -Definition NaturalIsomorphism `{Funext} (C D : PreCategory) F G := @Isomorphic (C -> D) F G. -Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. -Global Instance isisomorphism_compose' `{Funext} - `(T' : @NaturalTransformation C D F' F'') - `(T : @NaturalTransformation C D F F') - `{@IsIsomorphism (C -> D) F' F'' T'} - `{@IsIsomorphism (C -> D) F F' T} -: @IsIsomorphism (C -> D) F F'' (T' o T)%natural_transformation - := @isisomorphism_compose (C -> D) _ _ T' _ _ T _. -Section lemmas. - Context `{Funext}. - Variable C : PreCategory. - Variable F : C -> PreCategory. - Context - {w y z} - {f : Functor (F w) (F z)} {f0 : Functor (F w) (F y)} - {f2 : Functor (F y) (F z)} - {f5 : Functor (F w) (F z)} - {n2 : f <~=~> (f2 o f0)%functor}. - Lemma p_composition_of_coherent_iso_for_rewrite__isisomorphism_helper' XX - : @IsIsomorphism - (F w -> F z) f5 f - (n2 ^-1 o XX)%natural_transformation. - Proof. - eapply isisomorphism_compose'. - eapply isisomorphism_inverse. (* Toplevel input, characters 22-43: -Error: -In environment -H : Funext -C : PreCategory -F : C -> PreCategory -w : C -y : C -z : C -f : Functor (F w) (F z) -f0 : Functor (F w) (F y) -f2 : Functor (F y) (F z) -f5 : Functor (F w) (F z) -n2 : f <~=~> (f2 o f0)%functor -XX : NaturalTransformation f5 (f2 o f0) -Unable to unify - "{| - object := Functor (F w) (F z); - morphism := NaturalTransformation (D:=F z); - compose := composet (D:=F z); - associativity := associativityt (D:=F z) |}" with - "{| - object := Functor (F w) (F z); - morphism := NaturalTransformation (D:=F z); - compose := composet (D:=F z); - associativity := associativityt (D:=F z) |}". *) diff --git a/test-suite/bugs/closed/3402.v b/test-suite/bugs/closed/3402.v deleted file mode 100644 index b4705780db..0000000000 --- a/test-suite/bugs/closed/3402.v +++ /dev/null @@ -1,7 +0,0 @@ -Set Primitive Projections. -Record prod A B := pair { fst : A ; snd : B }. -Goal forall A B (p : prod A B), p = let (x, y) := p in pair A B x y. -Proof. - intros A B p. - exact eq_refl. -Qed. diff --git a/test-suite/bugs/closed/3408.v b/test-suite/bugs/closed/3408.v deleted file mode 100644 index b12b8c1afb..0000000000 --- a/test-suite/bugs/closed/3408.v +++ /dev/null @@ -1,163 +0,0 @@ -Require Import BinPos. - -Inductive expr : Type := - Var : nat -> expr -| App : expr -> expr -> expr -| Abs : unit -> expr -> expr. - -Inductive expr_acc -: expr -> expr -> Prop := - acc_App_l : forall f a : expr, - expr_acc f (App f a) -| acc_App_r : forall f a : expr, - expr_acc a (App f a) -| acc_Abs : forall (t : unit) (e : expr), - expr_acc e (Abs t e). - -Theorem wf_expr_acc : well_founded expr_acc. -Proof. - red. - refine (fix rec a : Acc expr_acc a := - match a as a return Acc expr_acc a with - | Var v => Acc_intro _ (fun y (_H : expr_acc y (Var v)) => - match _H in expr_acc z Z - return match Z return Prop with - | Var _ => Acc _ y - | _ => True - end - with - | acc_App_l _ _ => I - | _ => I - end) - | App f x => Acc_intro _ (fun y (pf : expr_acc y (App f x)) => - match pf in expr_acc z Z - return match Z return Prop with - | App a b => f = a -> x = b -> Acc expr_acc z - | _ => True - end - with - | acc_App_l f' x' => fun pf _ => match pf in _ = z return - Acc expr_acc z - with - | eq_refl => rec f - end - | acc_App_r f' x' => fun _ pf => match pf in _ = z return - Acc expr_acc z - with - | eq_refl => rec x - end - | _ => I - end eq_refl eq_refl) - | Abs t e => Acc_intro _ (fun y (pf : expr_acc y (Abs t e)) => - match pf in expr_acc z Z - return match Z return Prop with - | Abs a b => e = b -> Acc expr_acc z - | _ => True - end - with - | acc_Abs f x => fun pf => match pf in _ = z return - Acc expr_acc z - with - | eq_refl => rec e - end - | _ => I - end eq_refl) - end). -Defined. - -Theorem wf_expr_acc_delay : well_founded expr_acc. -Proof. - red. - refine (fix rec a : Acc expr_acc a := - match a as a return Acc expr_acc a with - | Var v => Acc_intro _ (fun y (_H : expr_acc y (Var v)) => - match _H in expr_acc z Z - return match Z return Prop with - | Var _ => Acc _ y - | _ => True - end - with - | acc_App_l _ _ => I - | _ => I - end) - | App f x => Acc_intro _ (fun y (pf : expr_acc y (App f x)) => - match pf in expr_acc z Z - return match Z return Prop with - | App a b => (unit -> Acc expr_acc a) -> (unit -> Acc expr_acc b) -> Acc expr_acc z - | _ => True - end - with - | acc_App_l f' x' => fun pf _ => pf tt - | acc_App_r f' x' => fun _ pf => pf tt - | _ => I - end (fun _ => rec f) (fun _ => rec x)) - | Abs t e => Acc_intro _ (fun y (pf : expr_acc y (Abs t e)) => - match pf in expr_acc z Z - return match Z return Prop with - | Abs a b => (unit -> Acc expr_acc b) -> Acc expr_acc z - | _ => True - end - with - | acc_Abs f x => fun pf => pf tt - | _ => I - end (fun _ => rec e)) - end); - try solve [ inversion _H ]. -Defined. - -Fixpoint build_large (n : nat) : expr := - match n with - | 0 => Var 0 - | S n => - let e := build_large n in - App e e - end. - -Section guard. - Context {A : Type} {R : A -> A -> Prop}. - - Fixpoint guard (n : nat) (wfR : well_founded R) : well_founded R := - match n with - | 0 => wfR - | S n0 => - fun x : A => - Acc_intro x - (fun (y : A) (_ : R y x) => guard n0 (guard n0 wfR) y) - end. -End guard. - - -Definition sizeF_delay : expr -> positive. -refine - (@Fix expr (expr_acc) - (wf_expr_acc_delay) - (fun _ => positive) - (fun e => - match e as e return (forall l, expr_acc l e -> positive) -> positive with - | Var _ => fun _ => 1 - | App l r => fun rec => @rec l _ + @rec r _ - | Abs _ e => fun rec => 1 + @rec e _ - end%positive)). -eapply acc_App_l. -eapply acc_App_r. -eapply acc_Abs. -Defined. - -Definition sizeF_guard : expr -> positive. -refine - (@Fix expr (expr_acc) - (guard 5 wf_expr_acc) - (fun _ => positive) - (fun e => - match e as e return (forall l, expr_acc l e -> positive) -> positive with - | Var _ => fun _ => 1 - | App l r => fun rec => @rec l _ + @rec r _ - | Abs _ e => fun rec => 1 + @rec e _ - end%positive)). -eapply acc_App_l. -eapply acc_App_r. -eapply acc_Abs. -Defined. - -Time Eval native_compute in sizeF_delay (build_large 2). -Time Eval native_compute in sizeF_guard (build_large 2). diff --git a/test-suite/bugs/closed/3416.v b/test-suite/bugs/closed/3416.v deleted file mode 100644 index 5cfb8f1ff4..0000000000 --- a/test-suite/bugs/closed/3416.v +++ /dev/null @@ -1,12 +0,0 @@ -Inductive list A := Node : node A -> list A -with node A := Nil | Cons : A -> list A -> node A. - -Fixpoint app {A} (l1 l2 : list A) {struct l1} : list A -with app_node {A} (n1 : node A) (l2 : list A) {struct n1} : node A. -Proof. -+ destruct l1 as [n]; constructor. - exact (app_node _ n l2). -+ destruct n1 as [|x l1]. - - destruct l2 as [n2]; exact n2. - - exact (Cons _ x (app _ l1 l2)). -Qed. diff --git a/test-suite/bugs/closed/3417.v b/test-suite/bugs/closed/3417.v deleted file mode 100644 index 9d7c6f013d..0000000000 --- a/test-suite/bugs/closed/3417.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Setoid. - -Goal forall {T}(a b : T), b=a -> {c | c=b}. -Proof. -intros T a b H. -try setoid_rewrite H. -Abort. diff --git a/test-suite/bugs/closed/3422.v b/test-suite/bugs/closed/3422.v deleted file mode 100644 index 460ae8f110..0000000000 --- a/test-suite/bugs/closed/3422.v +++ /dev/null @@ -1,209 +0,0 @@ -Require Import TestSuite.admit. -Generalizable All Variables. -Set Implicit Arguments. -Set Universe Polymorphism. -Axiom admit : forall {T}, T. -Reserved Infix "o" (at level 40, left associativity). -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. -Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Existing Instance equiv_isequiv. -Delimit Scope equiv_scope with equiv. -Local Open Scope equiv_scope. -Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. -Axiom IsHSet : Type -> Type. -Existing Class IsHSet. -Definition trunc_equiv' `(f : A <~> B) `{IsHSet A} : IsHSet B := admit. -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g); - - trunc_morphism : forall s d, IsHSet (morphism s d) }. - -Bind Scope category_scope with PreCategory. -Infix "o" := (@compose _ _ _ _) : morphism_scope. - -Delimit Scope functor_scope with functor. - -Record Functor (C D : PreCategory) := - { - object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d) - }. - -Bind Scope functor_scope with Functor. -Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. -Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. -Local Open Scope morphism_scope. - -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. - -Local Notation "m ^-1" := (morphism_inverse (m := m)) : morphism_scope. - -Class Isomorphic {C : PreCategory} s d := - { - morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic - }. - -Coercion morphism_isomorphic : Isomorphic >-> morphism. - -Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. - -Definition isisomorphism_inverse `(@IsIsomorphism C x y m) : IsIsomorphism m^-1 := {| morphism_inverse := m |}. - -Global Instance isisomorphism_compose `(@IsIsomorphism C y z m0) `(@IsIsomorphism C x y m1) -: IsIsomorphism (m0 o m1). -admit. -Defined. - -Section composition. - Variable C : PreCategory. - Variable D : PreCategory. - Variable E : PreCategory. - Variable G : Functor D E. - Variable F : Functor C D. - - Definition composeF : Functor C E - := Build_Functor - C E - (fun c => G (F c)) - (fun _ _ m => morphism_of G (morphism_of F m)). -End composition. -Infix "o" := composeF : functor_scope. - -Delimit Scope natural_transformation_scope with natural_transformation. -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. - -Section compose. - Variable C : PreCategory. - Variable D : PreCategory. - Variables F F' F'' : Functor C D. - - Variable T' : NaturalTransformation F' F''. - Variable T : NaturalTransformation F F'. - - Local Notation CO c := (T' c o T c). - - Definition composeT - : NaturalTransformation F F'' := Build_NaturalTransformation F F'' (fun c => CO c). - -End compose. - -Section whisker. - Variable C : PreCategory. - Variable D : PreCategory. - Variable E : PreCategory. - - Section L. - Variable F : Functor D E. - Variables G G' : Functor C D. - Variable T : NaturalTransformation G G'. - - Local Notation CO c := (morphism_of F (T c)). - - Definition whisker_l - := Build_NaturalTransformation - (F o G) (F o G') - (fun c => CO c). - - End L. - - Section R. - Variables F F' : Functor D E. - Variable T : NaturalTransformation F F'. - Variable G : Functor C D. - - Local Notation CO c := (T (G c)). - - Definition whisker_r - := Build_NaturalTransformation - (F o G) (F' o G) - (fun c => CO c). - End R. -End whisker. -Infix "o" := composeT : natural_transformation_scope. -Infix "oL" := whisker_l (at level 40, left associativity) : natural_transformation_scope. -Infix "oR" := whisker_r (at level 40, left associativity) : natural_transformation_scope. - -Section path_natural_transformation. - - Variable C : PreCategory. - Variable D : PreCategory. - Variables F G : Functor C D. - - Lemma equiv_sig_natural_transformation - : { CO : forall x, morphism D (F x) (G x) - | forall s d (m : morphism C s d), - CO d o F _1 m = G _1 m o CO s } - <~> NaturalTransformation F G. - admit. - Defined. - - Global Instance trunc_natural_transformation - : IsHSet (NaturalTransformation F G). - Proof. - eapply trunc_equiv'; [ exact equiv_sig_natural_transformation | ]. - admit. - Qed. - -End path_natural_transformation. -Definition functor_category (C D : PreCategory) : PreCategory - := @Build_PreCategory (Functor C D) (@NaturalTransformation C D) (@composeT C D) _. - -Notation "C -> D" := (functor_category C D) : category_scope. - -Definition NaturalIsomorphism (C D : PreCategory) F G := @Isomorphic (C -> D) F G. - -Coercion natural_transformation_of_natural_isomorphism C D F G (T : @NaturalIsomorphism C D F G) : NaturalTransformation F G - := T : morphism _ _ _. -Local Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. -Global Instance isisomorphism_compose' - `(T' : @NaturalTransformation C D F' F'') - `(T : @NaturalTransformation C D F F') - `{@IsIsomorphism (C -> D) F' F'' T'} - `{@IsIsomorphism (C -> D) F F' T} -: @IsIsomorphism (C -> D) F F'' (T' o T)%natural_transformation - := @isisomorphism_compose (C -> D) _ _ T' _ _ T _. - -Section lemmas. - Local Open Scope natural_transformation_scope. - - Variable C : PreCategory. - Variable F : C -> PreCategory. - Context - {w x y z} - {f : Functor (F w) (F z)} {f0 : Functor (F w) (F y)} - {f1 : Functor (F x) (F y)} {f2 : Functor (F y) (F z)} - {f3 : Functor (F w) (F x)} {f4 : Functor (F x) (F z)} - {f5 : Functor (F w) (F z)} {n : f5 <~=~> (f4 o f3)%functor} - {n0 : f4 <~=~> (f2 o f1)%functor} {n1 : f0 <~=~> (f1 o f3)%functor} - {n2 : f <~=~> (f2 o f0)%functor}. - - Lemma p_composition_of_coherent_iso_for_rewrite__isisomorphism_helper' - : @IsIsomorphism - (_ -> _) _ _ - (n2 ^-1 o (f2 oL n1 ^-1 o (admit o (n0 oR f3 o n))))%natural_transformation. - Proof. - eapply isisomorphism_compose'; - [ eapply isisomorphism_inverse - | eapply isisomorphism_compose'; - [ admit - | eapply isisomorphism_compose'; - [ admit | - eapply isisomorphism_compose'; [ admit | ]]]]. - Set Printing All. Set Printing Universes. - apply @isisomorphism_isomorphic. - Qed. - -End lemmas. diff --git a/test-suite/bugs/closed/3427.v b/test-suite/bugs/closed/3427.v deleted file mode 100644 index 9a57ca7703..0000000000 --- a/test-suite/bugs/closed/3427.v +++ /dev/null @@ -1,196 +0,0 @@ -Require Import TestSuite.admit. -(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 0 lines to 7171 lines, then from 7184 lines to 558 lines, then from 556 lines to 209 lines *) -Generalizable All Variables. -Set Universe Polymorphism. -Notation Type0 := Set. -Notation idmap := (fun x => x). -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. -Open Scope function_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Delimit Scope path_scope with path. -Local Open Scope path_scope. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. -Notation "1" := idpath : path_scope. -Notation "p @ q" := (concat p q) (at level 20) : path_scope. -Notation "p ^" := (inverse p) (at level 3) : path_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) := forall x:A, f x = g x. -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) : forall x, f x = g x := fun x => match h with idpath => idpath end. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) - }. -Record Equiv A B := BuildEquiv { - equiv_fun :> A -> B ; - equiv_isequiv :> IsEquiv equiv_fun - }. - -Delimit Scope equiv_scope with equiv. - -Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) - }. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Fixpoint nat_to_trunc_index (n : nat) : trunc_index - := match n with - | 0 => trunc_S (trunc_S minus_two) - | S n' => trunc_S (nat_to_trunc_index n') - end. - -Coercion nat_to_trunc_index : nat >-> trunc_index. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Notation minus_one:=(trunc_S minus_two). - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Notation Contr := (IsTrunc minus_two). -Notation IsHProp := (IsTrunc minus_one). -Notation IsHSet := (IsTrunc 0). - -Class Funext := - { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. - -Definition concat_pV {A : Type} {x y : A} (p : x = y) : - p @ p^ = 1 - := - match p with idpath => 1 end. - -Definition concat_Vp {A : Type} {x y : A} (p : x = y) : - p^ @ p = 1 - := - match p with idpath => 1 end. - -Definition transport_pp {A : Type} (P : A -> Type) {x y z : A} (p : x = y) (q : y = z) (u : P x) : - p @ q # u = q # p # u := - match q with idpath => - match p with idpath => 1 end - end. - -Definition transport2 {A : Type} (P : A -> Type) {x y : A} {p q : x = y} - (r : p = q) (z : P x) -: p # z = q # z - := ap (fun p' => p' # z) r. - -Inductive Unit : Type0 := - tt : Unit. - -Instance contr_unit : Contr Unit | 0 := let x := {| - center := tt; - contr := fun t : Unit => match t with tt => 1 end - |} in x. - -Instance trunc_succ `{IsTrunc n A} : IsTrunc (trunc_S n) A | 1000. -admit. -Defined. - -Record hProp := hp { hproptype :> Type ; isp : IsHProp hproptype}. -Definition Unit_hp:hProp:=(hp Unit _). - -Global Instance isequiv_ap_hproptype `{Funext} X Y : IsEquiv (@ap _ _ hproptype X Y). -admit. -Defined. - -Definition path_hprop `{Funext} X Y := (@ap _ _ hproptype X Y)^-1%equiv. - -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. -Local Open Scope equiv_scope. - -Instance isequiv_path {A B : Type} (p : A = B) -: IsEquiv (transport (fun X:Type => X) p) | 0 - := BuildIsEquiv _ _ _ (transport (fun X:Type => X) p^) - (fun b => ((transport_pp idmap p^ p b)^ @ transport2 idmap (concat_Vp p) b)) - (fun a => ((transport_pp idmap p p^ a)^ @ transport2 idmap (concat_pV p) a)) - (fun a => match p in _ = C return - (transport_pp idmap p^ p (transport idmap p a))^ @ - transport2 idmap (concat_Vp p) (transport idmap p a) = - ap (transport idmap p) ((transport_pp idmap p p^ a) ^ @ - transport2 idmap (concat_pV p) a) with idpath => 1 end). - -Definition equiv_path (A B : Type) (p : A = B) : A <~> B - := BuildEquiv _ _ (transport (fun X:Type => X) p) _. - -Class Univalence := { - isequiv_equiv_path :> forall (A B : Type), IsEquiv (equiv_path A B) - }. - -Section Univalence. - Context `{Univalence}. - - Definition path_universe_uncurried {A B : Type} (f : A <~> B) : A = B - := (equiv_path A B)^-1 f. -End Univalence. - -Local Inductive minus1Trunc (A :Type) : Type := - min1 : A -> minus1Trunc A. - -Instance minus1Trunc_is_prop {A : Type} : IsHProp (minus1Trunc A) | 0. -admit. -Defined. - -Definition hexists {X} (P:X->Type):Type:= minus1Trunc (sigT P). - -Section AssumingUA. - - Definition isepi {X Y} `(f:X->Y) := forall Z: hSet, - forall g h: Y -> Z, g o f = h o f -> g = h. - Context {X Y : hSet} (f : X -> Y) (Hisepi : isepi f). - - Goal forall (X Y : hSet) (f : forall _ : setT X, setT Y), - let fib := - fun y : setT Y => - hp (@hexists (setT X) (fun x : setT X => @paths (setT Y) (f x) y)) - (@minus1Trunc_is_prop - (@sigT (setT X) (fun x : setT X => @paths (setT Y) (f x) y))) in - forall (x : setT X) (_ : Univalence) (_ : Funext), - @paths hProp (fib (f x)) Unit_hp. - intros. - - apply path_hprop. - simpl. - Set Printing Universes. - Set Printing All. - refine (path_universe_uncurried _). - Undo. - apply path_universe_uncurried. (* Toplevel input, characters 21-44: -Error: Refiner was given an argument - "@path_universe_uncurried (* Top.425 Top.426 Top.427 Top.428 Top.429 *) X1 - (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) - (fun x0 : setT (* Top.405 *) X0 => - @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit - ?63" of type - "@paths (* Top.428 *) Type (* Top.425 *) - (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) - (fun x0 : setT (* Top.405 *) X0 => - @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit" -instead of - "@paths (* Top.413 *) Type (* Set *) - (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) - (fun x0 : setT (* Top.405 *) X0 => - @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit". - *) diff --git a/test-suite/bugs/closed/3428.v b/test-suite/bugs/closed/3428.v deleted file mode 100644 index 16ace90af3..0000000000 --- a/test-suite/bugs/closed/3428.v +++ /dev/null @@ -1,35 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 2809 lines to 39 lines *) -Set Primitive Projections. -Set Implicit Arguments. -Module Export foo. - Record prod (A B : Type) := pair { fst : A ; snd : B }. -End foo. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. -Axiom path_prod : forall {A B : Type} (z z' : prod A B), (fst z = fst z') -> (snd z = snd z') -> (z = z'). -Notation fst := (@fst _ _). -Notation snd := (@snd _ _). -Definition ap_fst_path_prod {A B : Type} {z z' : prod A B} (p : @paths A (fst z) (fst z')) (q : snd z = snd z') -: ap fst (path_prod z z' p q) = p. -Abort. - -Notation fstp x := (x.(foo.fst)). -Notation fstap x := (foo.fst x). - -Definition ap_fst_path_prod' {A B : Type} {z z' : prod A B} (p : @paths A (fst z) (fst z')) (q : snd z = snd z') -: ap (fun x => fstap x) (path_prod z z' p q) = p. - -Abort. - -(* Toplevel input, characters 137-138: -Error: -In environment -A : Type -B : Type -z : prod A B -z' : prod A B -p : @paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z') -q : @paths ?54 (foo.snd ?42 ?45 z) (foo.snd ?57 ?60 z') -The term "p" has type "@paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z')" -while it is expected to have type "@paths A (foo.fst z) (foo.fst z')". *) diff --git a/test-suite/bugs/closed/3439.v b/test-suite/bugs/closed/3439.v deleted file mode 100644 index e8c2d8b8ca..0000000000 --- a/test-suite/bugs/closed/3439.v +++ /dev/null @@ -1,44 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 3154 lines to 149 lines, then from 89 lines to 55 lines, then from 44 lines to 20 lines *) -Set Primitive Projections. -Generalizable All Variables. -Axiom IsHSet : Type -> Type. -Existing Class IsHSet. -Record PreCategory := { object :> Type }. -Notation IsStrictCategory C := (IsHSet (object C)). -Instance trunc_prod `{IsHSet A} `{IsHSet B} : IsHSet (A * B) | 100. -admit. -Defined. -Typeclasses Transparent object. -Definition prod (C D : PreCategory) : PreCategory := Build_PreCategory (Datatypes.prod C D). -Global Instance isstrict_category_product `{IsStrictCategory C, IsStrictCategory D} : IsStrictCategory (prod C D). -Proof. - typeclasses eauto. -Defined. - - -Set Typeclasses Debug. -(* File reduced by coq-bug-finder from original input, then from 7425 lines to 154 lines, then from 116 lines to 20 lines *) -Class Contr (A : Type) := { center : A }. -Instance contr_unit : Contr unit | 0 := {| center := tt |}. -Module non_prim. - Unset Primitive Projections. - Record PreCategory := { object :> Type }. - Lemma foo : Contr (object (@Build_PreCategory unit)). - Proof. - solve [ simpl; typeclasses eauto ] || fail "goal not solved". - Undo. - solve [ typeclasses eauto ]. - Defined. -End non_prim. - -Module prim. - Set Primitive Projections. - Record PreCategory := { object :> Type }. - Lemma foo : Contr (object (@Build_PreCategory unit)). - Proof. - solve [ simpl; typeclasses eauto ] || fail "goal not solved". - Undo. - solve [ typeclasses eauto ]. (* Error: No applicable tactic. *) - Defined. -End prim. diff --git a/test-suite/bugs/closed/3441.v b/test-suite/bugs/closed/3441.v deleted file mode 100644 index ddfb339443..0000000000 --- a/test-suite/bugs/closed/3441.v +++ /dev/null @@ -1,23 +0,0 @@ -Axiom f : nat -> nat -> nat. -Fixpoint do_n (n : nat) (k : nat) := - match n with - | 0 => k - | S n' => do_n n' (f k k) - end. - -Notation big := (_ = _). -Axiom k : nat. -Goal True. -Timeout 1 let H := fresh "H" in - let x := constr:(let n := 17 in do_n n = do_n n) in - let y := (eval lazy in x) in - pose proof y as H. (* Finished transaction in 1.102 secs (1.084u,0.016s) (successful) *) -Timeout 1 let H := fresh "H" in - let x := constr:(let n := 17 in do_n n = do_n n) in - let y := (eval lazy in x) in - pose y as H; clearbody H. (* Finished transaction in 0.412 secs (0.412u,0.s) (successful) *) - -Timeout 1 Time let H := fresh "H" in - let x := constr:(let n := 17 in do_n n = do_n n) in - let y := (eval lazy in x) in - assert (H := y). (* Finished transaction in 1.19 secs (1.164u,0.024s) (successful) *) diff --git a/test-suite/bugs/closed/3446.v b/test-suite/bugs/closed/3446.v deleted file mode 100644 index 8a0c98c333..0000000000 --- a/test-suite/bugs/closed/3446.v +++ /dev/null @@ -1,51 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 7372 lines to 539 lines, then from 531 lines to 107 lines, then from 76 lines to 46 lines *) -Module First. -Set Asymmetric Patterns. -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Notation "A -> B" := (forall (_ : A), B). -Set Universe Polymorphism. - - -Notation "x → y" := (x -> y) - (at level 99, y at level 200, right associativity): type_scope. -Record sigT A (P : A -> Type) := - { projT1 : A ; projT2 : P projT1 }. -Arguments projT1 {A P} s. -Arguments projT2 {A P} s. -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Reserved Notation "x = y" (at level 70, no associativity). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y). -Notation " x = y " := (paths x y) : type_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Reserved Notation "{ x : A & P }" (at level 0, x at level 99). -Notation "{ x : A & P }" := (sigT A (fun x => P)) : type_scope. - - -Axiom path_sigma_uncurried : forall {A : Type} (P : A -> Type) (u v : sigT A P) (pq : {p : projT1 u = projT1 v & transport _ p (projT2 u) = projT2 v}), u = v. -Axiom isequiv_pr1_contr : forall {A} {P : A -> Type}, (A -> {x : A & P x}). - -Definition path_sigma_hprop {A : Type} {P : A -> Type} (u v : sigT _ P) := - @compose _ _ _ (path_sigma_uncurried P u v) (@isequiv_pr1_contr _ _). -End First. - -Set Asymmetric Patterns. -Set Universe Polymorphism. -Arguments projT1 {_ _} _. -Notation "( x ; y )" := (existT _ x y). -Notation pr1 := projT1. -Notation "x .1" := (projT1 x) (at level 3). -Notation "x .2" := (projT2 x) (at level 3). -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Notation "g 'o' f" := (compose g f) (at level 40, left associativity). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3). -Axiom path_sigma_uncurried : forall {A : Type} (P : A -> Type) (u v : sigT P) (pq : {p : u.1 = v.1 & p # u.2 = v.2}), u = v. -Instance isequiv_pr1_contr {A} {P : A -> Type} : IsEquiv (@pr1 A P) | 100. -Admitted. - -Definition path_sigma_hprop {A : Type} {P : A -> Type} (u v : sigT P) : u.1 = v.1 -> u = v := - path_sigma_uncurried P u v o pr1^-1. diff --git a/test-suite/bugs/closed/3453.v b/test-suite/bugs/closed/3453.v deleted file mode 100644 index 4ee9b400a3..0000000000 --- a/test-suite/bugs/closed/3453.v +++ /dev/null @@ -1,10 +0,0 @@ -Set Primitive Projections. -Record Foo := { bar : Set }. -Class Baz (F : Foo) := { qux : F.(bar) }. -Coercion qux : Baz >-> bar. - -Definition f : Foo := {| bar := nat |}. -Canonical Structure f. -Check (fun b : Baz f => b : _.(bar)). - -(* Error: Found target class bar instead of bar. *) diff --git a/test-suite/bugs/closed/3454.v b/test-suite/bugs/closed/3454.v deleted file mode 100644 index ca4d23803e..0000000000 --- a/test-suite/bugs/closed/3454.v +++ /dev/null @@ -1,63 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. - -Record prod {A} {B}:= pair { fst : A ; snd : B }. -Notation " A * B " := (@prod A B) : type_scope. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Notation pr1 := (@projT1 _ _). -Arguments prod : clear implicits. - -Check (@projT1 _ (fun x : nat => x = x)). -Check (fun s : @sigT nat (fun x : nat => x = x) => s.(projT1)). - -Record rimpl {b : bool} {n : nat} := { foo : forall {x : nat}, x = n }. - -Check (fun r : @rimpl true 0 => r.(foo) (x:=0)). -Check (fun r : @rimpl true 0 => @foo true 0 r 0). -Check (fun r : @rimpl true 0 => foo r (x:=0)). -Check (fun r : @rimpl true 0 => @foo _ _ r 0). -Check (fun r : @rimpl true 0 => r.(@foo _ _)). -Check (fun r : @rimpl true 0 => r.(foo)). - -Notation "{ x : T & P }" := (@sigT T P). -Notation "{ x : A & P }" := (sigT (A:=A) (fun x => P)) : type_scope. -(* Notation "{ x : T * U & P }" := (@sigT (T * U) P). *) - -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Class IsEquiv {A B : Type} (f : A -> B) := {}. - -Local Instance isequiv_tgt_compose A B -: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) - (A -> B) - (@compose A {xy : B * B & fst xy = snd xy} B - (@compose {xy : B * B & fst xy = snd xy} _ B (@snd B B) pr1)). -(* Toplevel input, characters 220-223: *) -(* Error: Cannot infer this placeholder. *) - -Local Instance isequiv_tgt_compose' A B -: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) - (A -> B) - (@compose A {xy : B * B & fst xy = snd xy} B (@compose {xy : B * B & fst xy = snd xy} _ B (@snd _ _) pr1)). -(* Toplevel input, characters 221-232: *) -(* Error: *) -(* In environment *) -(* A : Type *) -(* B : Type *) -(* The term "pr1" has type "sigT ?30 -> ?29" while it is expected to have type *) -(* "{xy : B * B & fst xy = snd xy} -> ?27 * B". *) - -Local Instance isequiv_tgt_compose'' A B -: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) - (A -> B) - (@compose A {xy : B * B & fst xy = snd xy} B (@compose {xy : B * B & fst xy = snd xy} _ B (@snd _ _) - (fun s => s.(projT1)))). -(* Toplevel input, characters 15-241: -Error: -Cannot infer an internal placeholder of type "Type" in environment: - -A : Type -B : Type -x : ?32 -. *) diff --git a/test-suite/bugs/closed/3461.v b/test-suite/bugs/closed/3461.v deleted file mode 100644 index 1b625e6a15..0000000000 --- a/test-suite/bugs/closed/3461.v +++ /dev/null @@ -1,5 +0,0 @@ -Lemma foo (b : bool) : - exists x : nat, x = x. -Proof. -eexists. -Fail eexact (eq_refl b). diff --git a/test-suite/bugs/closed/3467.v b/test-suite/bugs/closed/3467.v deleted file mode 100644 index 88ae030578..0000000000 --- a/test-suite/bugs/closed/3467.v +++ /dev/null @@ -1,6 +0,0 @@ -Module foo. - Notation x := ltac:(exact I). -End foo. -Module bar. - Include foo. -End bar. diff --git a/test-suite/bugs/closed/3469.v b/test-suite/bugs/closed/3469.v deleted file mode 100644 index b09edc65b0..0000000000 --- a/test-suite/bugs/closed/3469.v +++ /dev/null @@ -1,29 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 538 lines to 31 lines *) -Open Scope type_scope. -Global Set Primitive Projections. -Set Implicit Arguments. -Record sig (A : Type) (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. -Notation sigT := sig (only parsing). -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. -Notation projT1 := proj1_sig (only parsing). -Notation projT2 := proj2_sig (only parsing). -Variables X : Type. -Variable R : X -> X -> Type. -Lemma dependent_choice : - (forall x:X, {y : _ & R x y}) -> - forall x0, {f : nat -> X & (f O = x0) * (forall n, R (f n) (f (S n)))}. -Proof. - intros H x0. - set (f:=fix f n := match n with O => x0 | S n' => projT1 (H (f n')) end). - exists f. - split. - reflexivity. - induction n; simpl in *. - clear. - apply (proj2_sig (H x0)). - Undo. - apply @proj2_sig. - - -(* Toplevel input, characters 21-31: -Error: Found no subterm matching "proj1_sig ?206" in the current *) diff --git a/test-suite/bugs/closed/3477.v b/test-suite/bugs/closed/3477.v deleted file mode 100644 index 3ed63604ea..0000000000 --- a/test-suite/bugs/closed/3477.v +++ /dev/null @@ -1,9 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. -Record prod A B := pair { fst : A ; snd : B }. -Goal forall A B : Set, True. -Proof. - intros A B. - evar (a : prod A B); evar (f : (prod A B -> Set)). - let a' := (eval unfold a in a) in - set(foo:=eq_refl : a' = (@pair _ _ (fst a') (snd a'))). diff --git a/test-suite/bugs/closed/3480.v b/test-suite/bugs/closed/3480.v deleted file mode 100644 index 35e0c51a93..0000000000 --- a/test-suite/bugs/closed/3480.v +++ /dev/null @@ -1,48 +0,0 @@ -Require Import TestSuite.admit. -Set Primitive Projections. -Axiom admit : forall {T}, T. -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Set Implicit Arguments. -Delimit Scope category_scope with category. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Local Open Scope category_scope. -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. -Class Isomorphic {C : PreCategory} s d := { morphism_isomorphic :> @morphism C s d ; isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. -Coercion morphism_isomorphic : Isomorphic >-> morphism. -Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. -Definition idtoiso (C : PreCategory) (x y : C) (H : x = y) : Isomorphic x y := admit. -Record NotionOfStructure (X : PreCategory) := { structure :> X -> Type }. -Record Smorphism (X : PreCategory) (P : NotionOfStructure X) (xa yb : { x : X & P x }) := { f : morphism X xa.1 yb.1 }. -Definition precategory_of_structures X (P : NotionOfStructure X) : PreCategory. -Proof. - refine (@Build_PreCategory _ (@Smorphism _ P)). -Defined. -Section sip. - Variable X : PreCategory. - Variable P : NotionOfStructure X. - - Let StrX := @precategory_of_structures X P. - - Definition sip_isotoid (xa yb : StrX) (f : xa <~=~> yb) : xa = yb. - admit. - Defined. - - Lemma structure_identity_principle_helper (xa yb : StrX) - (x : xa <~=~> yb) : Smorphism P xa yb. - Proof. - refine ((idtoiso (precategory_of_structures P) (sip_isotoid x) : @morphism _ _ _) : morphism _ _ _). -(* Toplevel input, characters 24-95: -Error: -In environment -X : PreCategory -P : NotionOfStructure X -StrX := precategory_of_structures P : PreCategory -xa : object StrX -yb : object StrX -x : xa <~=~> yb -The term "morphism_isomorphic:@morphism (precategory_of_structures P) xa yb" -has type "@morphism (precategory_of_structures P) xa yb" -while it is expected to have type "morphism ?40 ?41 ?42". *) diff --git a/test-suite/bugs/closed/3481.v b/test-suite/bugs/closed/3481.v deleted file mode 100644 index 38f03b166b..0000000000 --- a/test-suite/bugs/closed/3481.v +++ /dev/null @@ -1,70 +0,0 @@ - -Set Implicit Arguments. - -Require Import Logic. -Module NonPrim. -Local Set Nonrecursive Elimination Schemes. -Record prodwithlet (A B : Type) : Type := - pair' { fst : A; fst' := fst; snd : B }. - -Definition letreclet (p : prodwithlet nat nat) := - let (x, x', y) := p in x + y. - -Definition pletreclet (p : prodwithlet nat nat) := - let 'pair' x x' y := p in x + y + x'. - -Definition pletreclet2 (p : prodwithlet nat nat) := - let 'pair' x y := p in x + y. - -Check (pair 0 0). -End NonPrim. - -Global Set Universe Polymorphism. -Global Set Asymmetric Patterns. -Local Set Nonrecursive Elimination Schemes. -Local Set Primitive Projections. - -Record prod (A B : Type) : Type := - pair { fst : A; snd : B }. - -Print prod_rect. - -(* What I really want: *) -Definition prod_rect' A B (P : prod A B -> Type) (u : forall (fst : A) (snd : B), P (pair fst snd)) - (p : prod A B) : P p - := u (fst p) (snd p). - -Definition conv : @prod_rect = @prod_rect'. -Proof. reflexivity. Defined. - -Definition imposs := - (fun A B P f (p : prod A B) => match p as p0 return P p0 with - | {| fst := x ; snd := x0 |} => f x x0 - end). - -Definition letrec (p : prod nat nat) := - let (x, y) := p in x + y. -Eval compute in letrec (pair 1 5). - -Goal forall p : prod nat nat, letrec p = fst p + snd p. -Proof. - reflexivity. - Undo. - intros p. - case p. simpl. unfold letrec. simpl. reflexivity. -Defined. - -Eval compute in conv. (* = eq_refl - : prod_rect = prod_rect' *) - -Check eq_refl : @prod_rect = @prod_rect'. (* Toplevel input, characters 6-13: -Error: -The term "eq_refl" has type "prod_rect = prod_rect" -while it is expected to have type "prod_rect = prod_rect'" -(cannot unify "prod_rect" and "prod_rect'"). *) - -Record sigma (A : Type) (B : A -> Type) : Type := - dpair { pi1 : A ; pi2 : B pi1 }. - - - diff --git a/test-suite/bugs/closed/3482.v b/test-suite/bugs/closed/3482.v deleted file mode 100644 index 87fd2723c9..0000000000 --- a/test-suite/bugs/closed/3482.v +++ /dev/null @@ -1,11 +0,0 @@ -Set Primitive Projections. -Class Foo (F : False) := { foo : True }. -Arguments foo F {Foo}. -Print Implicit foo. (* foo : forall F : False, Foo F -> True - -Argument Foo is implicit and maximally inserted *) -Check foo _. (* Toplevel input, characters 6-11: -Error: Illegal application (Non-functional construction): -The expression "foo" of type "True" -cannot be applied to the term - "?36" : "?35" *) diff --git a/test-suite/bugs/closed/3483.v b/test-suite/bugs/closed/3483.v deleted file mode 100644 index 2cc6618620..0000000000 --- a/test-suite/bugs/closed/3483.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Check proper failing when using notation of non-constructors in - pattern-bmatching *) - -Fail Definition nonsense ( x : False ) := match x with y + 2 => 0 end. - diff --git a/test-suite/bugs/closed/3484.v b/test-suite/bugs/closed/3484.v deleted file mode 100644 index a0e157303f..0000000000 --- a/test-suite/bugs/closed/3484.v +++ /dev/null @@ -1,31 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 14259 lines to 305 lines, then from 237 lines to 120 lines, then from 100 lines to 30 lines *) -Set Primitive Projections. -Set Implicit Arguments. -Record sigT (A : Type) (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Notation "{ x : A & P }" := (@sigT A (fun x : A => P)) : type_scope. -Notation pr1 := (@projT1 _ _). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. -Goal forall (T : Type) (H : { g : T & g = g }) (x : T), projT1 H = projT1 (existT (fun g : T => g = g) x idpath). -Proof. - intros. - let y := match goal with |- projT1 ?x = projT1 ?y => constr:(y) end in - apply (@ap _ _ pr1 _ y). - Undo. - Unset Printing Notations. - apply (ap pr1). - Undo. - refine (ap pr1 _). -admit. -Defined. - -(* Toplevel input, characters 22-28: -Error: -In environment -T : Type -H : sigT T (fun g : T => paths g g) -x : T -Unable to unify "paths (@projT1 ?24 ?23 ?25) (@projT1 ?24 ?23 ?26)" with - "paths (projT1 H) (projT1 {| projT1 := x; projT2 := idpath |})". *) diff --git a/test-suite/bugs/closed/3485.v b/test-suite/bugs/closed/3485.v deleted file mode 100644 index ede6b3cb27..0000000000 --- a/test-suite/bugs/closed/3485.v +++ /dev/null @@ -1,133 +0,0 @@ -Set Universe Polymorphism. -Set Primitive Projections. -Reserved Infix "o" (at level 40, left associativity). -Definition relation (A : Type) := A -> A -> Type. -Class Transitive {A} (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z. -Tactic Notation "etransitivity" open_constr(y) := - let R := match goal with |- ?R ?x ?z => constr:(R) end in - let x := match goal with |- ?R ?x ?z => constr:(x) end in - let z := match goal with |- ?R ?x ?z => constr:(z) end in - refine (@transitivity _ R _ x y z _ _). -Tactic Notation "etransitivity" := etransitivity _. -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. -Notation "x .2" := (projT2 x) (at level 3) : fibration_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. -Instance transitive_paths {A} : Transitive (@paths A) | 0 := @concat A. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. -Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center = y) }. -Generalizable Variables X A B C f g n. -Definition projT1_path `{P : A -> Type} {u v : sigT P} (p : u = v) : u.1 = v.1 := ap (@projT1 _ _) p. -Notation "p ..1" := (projT1_path p) (at level 3) : fibration_scope. -Ltac simpl_do_clear tac term := - let H := fresh in - assert (H := term); - simpl in H |- *; - tac H; - clear H. -Set Implicit Arguments. -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g); - - left_identity : forall a b (f : morphism a b), identity b o f = f; - right_identity : forall a b (f : morphism a b), f o identity a = f }. -Arguments identity {C%category} / x%object : rename. -Arguments compose {C%category} / {s d d'}%object (m1 m2)%morphism : rename. -Infix "o" := compose : morphism_scope. -Notation "1" := (identity _) : morphism_scope. -Delimit Scope functor_scope with functor. -Local Open Scope morphism_scope. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d); - identity_of : forall x, morphism_of _ _ (identity x) - = identity (object_of x) }. -Bind Scope functor_scope with Functor. -Arguments morphism_of [C%category] [D%category] F%functor / [s%object d%object] m%morphism : rename. -Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. -Section composition. - Variable C : PreCategory. - Variable D : PreCategory. - Variable E : PreCategory. - Variable G : Functor D E. - Variable F : Functor C D. - - Local Notation c_object_of c := (G (F c)) (only parsing). - Local Notation c_morphism_of m := (morphism_of G (morphism_of F m)) (only parsing). - - Definition compose_identity_of x - : c_morphism_of (identity x) = identity (c_object_of x) - := transport (@paths _ _) - (identity_of G _) - (ap (@morphism_of _ _ G _ _) (identity_of F x)). - - Definition composeF : Functor C E - := Build_Functor - C E - (fun c => G (F c)) - (fun _ _ m => morphism_of G (morphism_of F m)) - compose_identity_of. -End composition. -Infix "o" := composeF : functor_scope. - -Definition identityF C : Functor C C - := Build_Functor C C - (fun x => x) - (fun _ _ x => x) - (fun _ => idpath). -Notation "1" := (identityF _) : functor_scope. - -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. - -Section unit. - Variable C : PreCategory. - Variable D : PreCategory. - Variable F : Functor C D. - Variable G : Functor D C. - - Definition AdjunctionUnit := - { T : NaturalTransformation 1 (G o F) - & forall (c : C) (d : D) (f : morphism C c (G d)), - Contr_internal { g : morphism D (F c) d & G _1 g o T c = f } - }. -End unit. -Variable C : PreCategory. -Variable D : PreCategory. -Variable F : Functor C D. -Variable G : Functor D C. - -Definition zig__of__adjunction_unit - (A : AdjunctionUnit F G) - (Y : C) - (eta := A.1) - (eps := fun X => (@center _ (A.2 (G X) X 1)).1) -: G _1 (eps (F Y) o F _1 (eta Y)) o eta Y = eta Y - -> eps (F Y) o F _1 (eta Y) = 1. -Proof. - intros. - etransitivity; [ symmetry | ]; - simpl_do_clear - ltac:(fun H => apply H) - (fun y H => (@contr _ (A.2 _ _ (A.1 Y)) (y; H))..1); - try assumption. - simpl. - rewrite ?@identity_of, ?@left_identity, ?@right_identity; - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/3487.v b/test-suite/bugs/closed/3487.v deleted file mode 100644 index 1321a8598c..0000000000 --- a/test-suite/bugs/closed/3487.v +++ /dev/null @@ -1,8 +0,0 @@ -Notation bar := ltac:(exact I). -Notation foo := bar (only parsing). -Class baz := { x : False }. -Instance: baz. -Admitted. -Definition baz0 := ((_ : baz) = (_ : baz)). -Definition foo1 := (foo = foo). -Definition baz1 := prod ((_ : baz) = (_ : baz)) (foo = foo). diff --git a/test-suite/bugs/closed/3490.v b/test-suite/bugs/closed/3490.v deleted file mode 100644 index e7a5caa1de..0000000000 --- a/test-suite/bugs/closed/3490.v +++ /dev/null @@ -1,27 +0,0 @@ -Inductive T : Type := -| Var : nat -> T -| Arr : T -> T -> T. - -Inductive Tele : list T -> Type := -| Tnil : @Tele nil -| Tcons : forall ls, forall (t : @Tele ls) (l : T), @Tele (l :: ls). - -Fail Fixpoint TeleD (ls : list T) (t : Tele ls) {struct t} - : { x : Type & x -> nat -> Type } := - match t return { x : Type & x -> nat -> Type } with - | Tnil => @existT Type (fun x => x -> nat -> Type) unit (fun (_ : unit) (_ : nat) => unit) - | Tcons ls t' l => - let (result, get) := TeleD ls t' in - @existT Type (fun x => x -> nat -> Type) - { v : result & (fix TD (t : T) {struct t} := - match t with - | Var n => - get v n - | Arr a b => TD a -> TD b - end) l } - (fun x n => - match n return Type with - | 0 => projT2 x - | S n => get (projT1 x) n - end) - end. diff --git a/test-suite/bugs/closed/3491.v b/test-suite/bugs/closed/3491.v deleted file mode 100644 index fd394ddbc3..0000000000 --- a/test-suite/bugs/closed/3491.v +++ /dev/null @@ -1,4 +0,0 @@ -(* Was failing while building the _rect scheme, due to wrong computation of *) -(* the number of non recursively uniform parameters in the presence of let-ins*) -Inductive list (A : Type) (T := A) : Type := - nil : list A | cons : T -> list T -> list A. diff --git a/test-suite/bugs/closed/3495.v b/test-suite/bugs/closed/3495.v deleted file mode 100644 index 102a2aba0d..0000000000 --- a/test-suite/bugs/closed/3495.v +++ /dev/null @@ -1,18 +0,0 @@ -Require Import RelationClasses. - -Axiom R : Prop -> Prop -> Prop. -Declare Instance : Reflexive R. - -Class bar := { x : False }. -Record foo := { a : Prop ; b : bar }. - -Definition default_foo (a0 : Prop) `{b : bar} : foo := {| a := a0 ; b := b |}. - -Goal exists k, R k True. -Proof. -eexists. -evar (b : bar). -let e := match goal with |- R ?e _ => constr:(e) end in -unify e (a (default_foo True)). -subst b. -reflexivity. diff --git a/test-suite/bugs/closed/3505.v b/test-suite/bugs/closed/3505.v deleted file mode 100644 index 2695bc796e..0000000000 --- a/test-suite/bugs/closed/3505.v +++ /dev/null @@ -1,44 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 7421 lines to 6082 lines, then from 5860 lines to 5369 lines, then from 5300 lines to 165 lines, then from 111 lines to 38 lines *) -Set Implicit Arguments. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - identity : forall x, morphism x x }. -Bind Scope category_scope with PreCategory. -Local Notation "1" := (identity _ _) : morphism_scope. -Local Open Scope morphism_scope. -Definition prod (C D : PreCategory) : PreCategory - := @Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) * morphism D (snd s) (snd d))%type) - (fun x => (identity _ (fst x), identity _ (snd x))). -Local Infix "*" := prod : category_scope. -Module NonPrim. - Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); - identity_of : forall x, morphism_of _ _ (identity _ x) = identity _ (object_of x) }. - Notation "F '_1' m" := (morphism_of F _ _ m) (at level 10, no associativity) : morphism_scope. - Goal forall C1 C2 D (F : Functor (C1 * C2) D) x, F _1 (1, 1) = identity _ (F x). - Proof. - intros. - rewrite identity_of. - reflexivity. - Qed. -End NonPrim. -Module Prim. - Set Primitive Projections. - Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); - identity_of : forall x, morphism_of _ _ (identity _ x) = identity _ (object_of x) }. - Notation "F '_1' m" := (morphism_of F _ _ m) (at level 10, no associativity) : morphism_scope. - Goal forall C1 C2 D (F : Functor (C1 * C2) D) x, F _1 (1, 1) = identity _ (F x). - Proof. - intros. - rewrite identity_of. (* Toplevel input, characters 0-20: -Error: -Found no subterm matching "morphism_of ?192 ?193 ?193 (identity ?190 ?193)" in the current goal. *) - reflexivity. - Qed. -End Prim. diff --git a/test-suite/bugs/closed/3509.v b/test-suite/bugs/closed/3509.v deleted file mode 100644 index 8226622670..0000000000 --- a/test-suite/bugs/closed/3509.v +++ /dev/null @@ -1,6 +0,0 @@ -Inductive T := Foo : T. -Axiom (b : T) (R : forall x : T, Prop) (f : forall x : T, R x). -Axiom a1 : match b with Foo => f end = f. -Axiom a2 : match b with Foo => f b end = f b. -Hint Rewrite a1 : bar. -Hint Rewrite a2 : bar. diff --git a/test-suite/bugs/closed/3510.v b/test-suite/bugs/closed/3510.v deleted file mode 100644 index 4cbae33590..0000000000 --- a/test-suite/bugs/closed/3510.v +++ /dev/null @@ -1,5 +0,0 @@ -Inductive T := Foo : T. -Axiom (b : T) (R : forall x : T, Prop) (f : forall x : T, R x). -Axiom a1 : match b with Foo => f end = f. -Axiom a2 : match b with Foo => f b end = f b. -Hint Rewrite a1 a2 : bar. diff --git a/test-suite/bugs/closed/3513.v b/test-suite/bugs/closed/3513.v deleted file mode 100644 index a1d0b9107b..0000000000 --- a/test-suite/bugs/closed/3513.v +++ /dev/null @@ -1,74 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines *) -Require Coq.Setoids.Setoid. -Import Coq.Setoids.Setoid. -Generalizable All Variables. -Axiom admit : forall {T}, T. -Class Equiv (A : Type) := equiv : relation A. -Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. -Class ILogicOps Frm := { lentails: relation Frm; - ltrue: Frm; - land: Frm -> Frm -> Frm; - lor: Frm -> Frm -> Frm }. -Infix "|--" := lentails (at level 79, no associativity). -Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }. -Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P. -Infix "-|-" := lequiv (at level 85, no associativity). -Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit. -Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }. -Section ILogic_Fun. - Context (T: Type) `{TType: type T}. - Context `{IL: ILogic Frm}. - Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. - Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. -End ILogic_Fun. -Arguments ILFunFrm _ {e} _ {ILOps}. -Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; - ltrue := True; - land P Q := P /\ Q; - lor P Q := P \/ Q |}. -Axiom Action : Set. -Definition Actions := list Action. -Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }. -Definition OPred := ILFunFrm Actions Prop. -Local Existing Instance ILFun_Ops. -Local Existing Instance ILFun_ILogic. -Definition catOP (P Q: OPred) : OPred := admit. -Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. -apply admit. -Defined. -Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. -Class IsPointed (T : Type) := point : T. -Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). -Record PointedOPred := mkPointedOPred { - OPred_pred :> OPred; - OPred_inhabited: IsPointed_OPred OPred_pred - }. -Existing Instance OPred_inhabited. -Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred - := {| OPred_pred := O ; OPred_inhabited := _ |}. -Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit. -Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) - (tr : T -> T) (O2 : PointedOPred) (x : T) - (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0), - exists e1 e2, - catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2. - intros; do 2 esplit. - rewrite <- catOPA. - lazymatch goal with - | |- ?R (?f ?a ?b) (?f ?a' ?b') => - let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred) - (@Morphisms.respectful OPred (OPred -> OPred) - (@lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop)) - (@lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==> - @lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP - catOP_entails_m_Proper a a' H b b' H') in - pose P; - refine (P _ _) - end; unfold Basics.flip. - Focus 2. - (* As in 8.5, allow a shelved subgoal to remain *) - apply reflexivity. - diff --git a/test-suite/bugs/closed/3520.v b/test-suite/bugs/closed/3520.v deleted file mode 100644 index ea122e521f..0000000000 --- a/test-suite/bugs/closed/3520.v +++ /dev/null @@ -1,12 +0,0 @@ -Set Primitive Projections. - -Record foo (A : Type) := - { bar : Type ; baz := Set; bad : baz = bar }. - -Set Nonrecursive Elimination Schemes. - -Record notprim : Prop := - { irrel : True; relevant : nat }. - - - diff --git a/test-suite/bugs/closed/3531.v b/test-suite/bugs/closed/3531.v deleted file mode 100644 index 3502b4f549..0000000000 --- a/test-suite/bugs/closed/3531.v +++ /dev/null @@ -1,54 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 270 lines to -198 lines, then from 178 lines to 82 lines, then from 88 lines to 59 lines *) -(* coqc version trunk (August 2014) compiled on Aug 19 2014 14:40:15 with OCaml -4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk -(56ece74efc25af1b0e09265f3c7fcf74323abcaf) *) -Require Import Coq.Lists.List. -Set Implicit Arguments. -Definition mem := nat -> option nat. -Definition pred := mem -> Prop. -Delimit Scope pred_scope with pred. -Definition exis A (p : A -> pred) : pred := fun m => exists x, p x m. -Notation "'exists' x .. y , p" := (exis (fun x => .. (exis (fun y => p)) ..)) : -pred_scope. -Definition emp : pred := fun m => forall a, m a = None. -Definition lift_empty (P : Prop) : pred := fun m => P /\ forall a, m a = None. -Notation "[[ P ]]" := (lift_empty P) : pred_scope. -Definition pimpl (p q : pred) := forall m, p m -> q m. -Notation "p ==> q" := (pimpl p%pred q%pred) (right associativity, at level 90). -Definition piff (p q : pred) : Prop := (p ==> q) /\ (q ==> p). -Notation "p <==> q" := (piff p%pred q%pred) (at level 90). -Parameter sep_star : pred -> pred -> pred. -Infix "*" := sep_star : pred_scope. -Definition memis (m : mem) : pred := eq m. -Definition mptsto (m : mem) (a : nat) (v : nat) := m a = Some v. -Notation "m @ a |-> v" := (mptsto m a v) (a at level 34, at level 35). -Lemma piff_trans: forall a b c, (a <==> b) -> (b <==> c) -> (a <==> c). -Admitted. -Lemma piff_refl: forall a, (a <==> a). -Admitted. -Definition stars (ps : list pred) := fold_left sep_star ps emp. -Lemma flatten_exists: forall T PT p ps P, - (forall (a:T), (p a <==> exists (x:PT), stars (ps a x) * [[P a x]])) - -> (exists (a:T), p a) <==> - (exists (x:(T*PT)), stars (ps (fst x) (snd x)) * [[P (fst x) (snd x)]]). -Admitted. -Goal forall b, (exists e1 e2 e3, - (exists (m : mem) (v : nat) (F : pred), b) - <==> (exists x : e1, stars (e2 x) * [[e3 x]])). - intros. - Set Printing Universes. - Show Universes. - do 3 eapply ex_intro. - eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. - eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. - eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. - assert (H : False) by (clear; admit); destruct H. - Grab Existential Variables. - admit. - admit. - admit. - Show Universes. -Time Qed. diff --git a/test-suite/bugs/closed/3537.v b/test-suite/bugs/closed/3537.v deleted file mode 100644 index 158642f01d..0000000000 --- a/test-suite/bugs/closed/3537.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Another instance of bug #3262, on looping in unification *) - -Inductive bool := true | false. - -Inductive RBT2 : forall a:bool, Type := - Full2 : forall (a b c n:bool), - forall H:RBT2 n, RBT2 n. - -Definition balance4 color p q r := - match color, p, q, r with - | _,_,_,_ => Full2 color p q r - end. diff --git a/test-suite/bugs/closed/3539.v b/test-suite/bugs/closed/3539.v deleted file mode 100644 index b0c4b23702..0000000000 --- a/test-suite/bugs/closed/3539.v +++ /dev/null @@ -1,66 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 11678 lines to 11330 lines, then from 10721 lines to 9544 lines, then from 9549 lines to 794 lines, then from 810 lines to 785 lines, then from 628 lines to 246 lines, then from 220 lines to 89 lines, then from 80 lines to 47 lines *) -(* coqc version trunk (August 2014) compiled on Aug 22 2014 4:17:28 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (a67cc6941434124465f20b14a1256f2ede31a60e) *) - -Set Implicit Arguments. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Local Set Primitive Projections. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Axiom path_prod : forall {A B : Type} (z z' : A * B), (fst z = fst z') -> (snd z = snd z') -> (z = z'). -Axiom transport_path_prod : forall A B (P : A * B -> Type) (x y : A * B) (HA : fst x = fst y) (HB : snd x = snd y) Px, - transport P (path_prod _ _ HA HB) Px - = transport (fun x => P (x, snd y)) HA (transport (fun y => P (fst x, y)) HB Px). -Goal forall (T0 : Type) (snd1 snd0 f : T0) (p : @paths T0 f snd0) - (f0 : T0) (p1 : @paths T0 f0 snd1) (T1 : Type) - (fst1 fst0 : T1) (p0 : @paths T1 fst0 fst0) (p2 : @paths T1 fst1 fst1) - (T : Type) (x2 : T) (T2 : Type) (T3 : forall (_ : T2) (_ : T2), Type) - (x' : forall (_ : T1) (_ : T), T2) (m : T3 (x' fst1 x2) (x' fst0 x2)), - @paths (T3 (x' fst1 x2) (x' fst0 x2)) - (@transport (prod T1 T0) - (fun x : prod T1 T0 => - T3 (x' fst1 x2) (x' (fst x) x2)) - (@pair T1 T0 fst0 f) (@pair T1 T0 fst0 snd0) - (@path_prod T1 T0 (@pair T1 T0 fst0 f) - (@pair T1 T0 fst0 snd0) p0 p) - (@transport (prod T1 T0) - (fun x : prod T1 T0 => - T3 (x' (fst x) x2) (x' fst0 x2)) - (@pair T1 T0 fst1 f0) (@pair T1 T0 fst1 snd1) - (@path_prod T1 T0 (@pair T1 T0 fst1 f0) - (@pair T1 T0 fst1 snd1) p2 p1) m)) m. - intros. - match goal with - | [ |- context[transport ?P (path_prod ?x ?y ?HA ?HB) ?Px] ] - => rewrite (transport_path_prod P x y HA HB Px) - end || fail "bad". - Undo. - Set Printing All. - rewrite transport_path_prod. (* Toplevel input, characters 15-43: -Error: -In environment -T0 : Type -snd1 : T0 -snd0 : T0 -f : T0 -p : @paths T0 f snd0 -f0 : T0 -p1 : @paths T0 f0 snd1 -T1 : Type -fst1 : T1 -fst0 : T1 -p0 : @paths T1 fst0 fst0 -p2 : @paths T1 fst1 fst1 -T : Type -x2 : T -T2 : Type -T3 : forall (_ : T2) (_ : T2), Type -x' : forall (_ : T1) (_ : T), T2 -m : T3 (x' fst1 x2) (x' fst0 x2) -Unable to unify "?25 (@pair ?23 ?24 (fst ?27) (snd ?27))" with -"?25 ?27". - *) diff --git a/test-suite/bugs/closed/3542.v b/test-suite/bugs/closed/3542.v deleted file mode 100644 index b6837a0c33..0000000000 --- a/test-suite/bugs/closed/3542.v +++ /dev/null @@ -1,6 +0,0 @@ -Section foo. - Context {A:Type} {B : A -> Type}. - Context (f : forall x, B x). - Goal True. - pose (r := fun k => existT (fun g => forall x, f x = g x) - (fun x => projT1 (k x)) (fun x => projT2 (k x))). diff --git a/test-suite/bugs/closed/3546.v b/test-suite/bugs/closed/3546.v deleted file mode 100644 index 55d718bd03..0000000000 --- a/test-suite/bugs/closed/3546.v +++ /dev/null @@ -1,17 +0,0 @@ -Set Primitive Projections. -Record prod A B := pair { fst : A ; snd : B }. -Arguments pair {_ _} _ _. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Definition ap11 {A B} {f g:A->B} (h:f=g) {x y:A} (p:x=y) : f x = g y. -Admitted. -Goal forall x y z w : Set, (x, y) = (z, w). -Proof. - intros. - apply ap11. (* Toplevel input, characters 21-25: -Error: In environment -x : Set -y : Set -z : Set -w : Set -Unable to unify "?31 ?191 = ?32 ?192" with "(x, y) = (z, w)". - *) diff --git a/test-suite/bugs/closed/3554.v b/test-suite/bugs/closed/3554.v deleted file mode 100644 index 13a79cc840..0000000000 --- a/test-suite/bugs/closed/3554.v +++ /dev/null @@ -1 +0,0 @@ -Example foo (f : forall {_ : Type}, Type) : Type. diff --git a/test-suite/bugs/closed/3559.v b/test-suite/bugs/closed/3559.v deleted file mode 100644 index 5210b27032..0000000000 --- a/test-suite/bugs/closed/3559.v +++ /dev/null @@ -1,88 +0,0 @@ -Unset Strict Universe Declaration. -(* File reduced by coq-bug-finder from original input, then from 8657 lines to -4731 lines, then from 4174 lines to 192 lines, then from 161 lines to 55 lines, -then from 51 lines to 37 lines, then from 43 lines to 30 lines *) -(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml -4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk -(437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) -Require Import Coq.Init.Notations. -Set Universe Polymorphism. -Generalizable All Variables. -Record prod A B := pair { fst : A ; snd : B }. -Arguments pair {_ _} _ _. -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Reserved Notation "x <-> y" (at level 95, no associativity). -Reserved Notation "x = y" (at level 70, no associativity). -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Open Scope type_scope. - -Definition iff A B := prod (A -> B) (B -> A). -Infix "<->" := iff : type_scope. -Inductive paths {A : Type@{i}} (a : A) : A -> Type@{i} := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center -= y) }. -Inductive trunc_index : Type := minus_two | trunc_S (_ : trunc_index). -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type@{i}) : Type@{i} := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. -Notation minus_one:=(trunc_S minus_two). -Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : -IsTrunc_internal n A. -Instance istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) : -IsTrunc n (x = y) := H x y. - -Axiom cheat : forall {A}, A. - -Lemma paths_lift (A : Type@{i}) (x y : A) (p : x = y) : paths@{j} x y. -Proof. - destruct p. apply idpath. -Defined. - -Lemma paths_change (A : Type@{i}) (x y : A) : paths@{j} x y = paths@{i} x y. -Proof. (* require Univalence *) - apply cheat. -Defined. - -Lemma IsTrunc_lift (n : trunc_index) : - forall (A : Type@{i}), IsTrunc_internal@{i} n A -> IsTrunc_internal@{j} n A. -Proof. - induction n; simpl; intros. - destruct X. exists center0. intros. apply (paths_lift _ _ _ (contr0 y)). - - rewrite paths_change. - apply IHn, X. -Defined. - -Notation IsHProp := (IsTrunc minus_one). -(* Record hProp := hp { hproptype :> Type ; isp : IsTrunc minus_one hproptype}. *) -(* Make the truncation proof polymorphic, i.e., available at any level greater or equal - to the carrier type level j *) -Record hProp := hp { hproptype :> Type@{j} ; isp : IsTrunc minus_one hproptype}. -Axiom path_iff_hprop_uncurried : forall `{IsHProp A, IsHProp B}, (A <-> B) -> A -= B. -Inductive V : Type@{U'} := | set {A : Type@{U}} (f : A -> V) : V. -Axiom is0trunc_V : IsTrunc (trunc_S (trunc_S minus_two)) V. -Existing Instance is0trunc_V. -Axiom bisimulation : V@{U' U} -> V@{U' U} -> hProp@{U'}. -Axiom bisimulation_refl : forall (v : V), bisimulation v v. -Axiom bisimulation_eq : forall (u v : V), bisimulation u v -> u = v. -Notation "u ~~ v" := (bisimulation u v) (at level 30). -Lemma bisimulation_equals_id : forall u v : V@{i j}, (u = v) = (u ~~ v). -Proof. - intros u v. - refine (@path_iff_hprop_uncurried _ _ _ _ _). -(* path_iff_hprop_uncurried : *) -(* forall A : Type@{Top.74}, *) -(* IsHProp A -> forall B : Type@{Top.74}, IsHProp B -> A <-> B -> A = B *) -(* (* Top.74 *) -(* Top.78 |= Top.74 < Top.78 *) -(* *) *) - - Show Universes. - exact (isp _). - split; intros. destruct X. apply bisimulation_refl. - apply bisimulation_eq, X. -Defined. diff --git a/test-suite/bugs/closed/3560.v b/test-suite/bugs/closed/3560.v deleted file mode 100644 index a740675f30..0000000000 --- a/test-suite/bugs/closed/3560.v +++ /dev/null @@ -1,15 +0,0 @@ - -(* File reduced by coq-bug-finder from original input, then from 6236 lines to 1049 lines, then from 920 lines to 209 lines, then from 179 lines to 30 lines *) -(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) - -Set Primitive Projections. -Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv : forall P, P equiv_fun }. -Goal forall (A B : Type) (C : Type), Equiv (A -> B -> C) (A * B -> C). -Proof. - intros. - exists (fun u => fun x => u (fst x) (snd x)). -Abort. diff --git a/test-suite/bugs/closed/3561.v b/test-suite/bugs/closed/3561.v deleted file mode 100644 index ef4422eeac..0000000000 --- a/test-suite/bugs/closed/3561.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 6343 lines to 2362 lines, then from 2115 lines to 303 lines, then from 321 lines to 90 lines, then from 95 lines to 41 lines *) -(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) -Set Primitive Projections. -Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). -Lemma ap_transport {A} {P Q : A -> Type} {x y : A} (p : x = y) (f : forall x, P x -> Q x) (z : P x) : - f y (p # z) = (p # (f x z)). -Proof. admit. -Defined. -Lemma foo A B (f : A * B -> A) : f = f. -Admitted. -Goal forall (H0 H2 : Type) x p, - @transport (prod H0 H2) - (fun GO : prod H0 H2 => x (fst GO)) = p. - intros. - match goal with - | [ |- context[x (?f _)] ] => set(foo':=f) - end. diff --git a/test-suite/bugs/closed/3562.v b/test-suite/bugs/closed/3562.v deleted file mode 100644 index 1a1410a3b1..0000000000 --- a/test-suite/bugs/closed/3562.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Should not be an anomaly as it was at some time in - September/October 2014 but some "Disjunctive/conjunctive - introduction pattern expected" error *) - -Theorem t: True. -Fail destruct 0 as x. diff --git a/test-suite/bugs/closed/3563.v b/test-suite/bugs/closed/3563.v deleted file mode 100644 index 961563ed4a..0000000000 --- a/test-suite/bugs/closed/3563.v +++ /dev/null @@ -1,38 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 11716 lines to 11295 lines, then from 10518 lines to 21 lines, then \ -from 37 lines to 21 lines *) -(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) -Set Primitive Projections. -Record prod A B := pair { fst : A ; snd : B }. -Arguments pair {A B} _ _. -Arguments fst {A B} _ / . -Arguments snd {A B} _ / . -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> H * H0) - (H4 : (fun c : H1 => (fst (H3 c), snd (H3 c))%core) = - H3) (H5 : H -> Type) (H6 H7 : H5 (fst (H3 H2))), - transport (fun y : H1 -> H * H0 => H5 (fst (y H2))) H4 H6 = H7. - intros. - match goal with - | [ |- context ctx [transport (fun y => (?g (@fst ?C ?h (y H2)))) H4 H6] ] - => set(foo:=h); idtac - end. - match goal with - | [ |- context ctx [transport (fun y => (?g (fst (y H2))))] ] - => idtac - end. -Abort. -Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> (H1 -> H) * H0) - (H4 : (fun c : H1 => (fst (H3 c), snd (H3 c))%core) = - H3) (H5 : H -> Type) (H6 H7 : H5 (fst (H3 H2) H2)), - transport (fun y : H1 -> (H1 -> H) * H0 => H5 (fst (y H2) H2)) H4 H6 = H7. - intros. - match goal with - | [ |- context ctx [transport (fun y => (?g (@fst ?C ?D (y H2) ?X)))] ] - => set(foo:=X) - end. -(* Anomaly: Uncaught exception Not_found(_). Please report. *) - -(* Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/3566.v b/test-suite/bugs/closed/3566.v deleted file mode 100644 index e2d7976981..0000000000 --- a/test-suite/bugs/closed/3566.v +++ /dev/null @@ -1,23 +0,0 @@ -Unset Strict Universe Declaration. -Notation idmap := (fun x => x). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Delimit Scope path_scope with path. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. -Notation "p @ q" := (concat p q) (at level 20) : path_scope. -Notation "p ^" := (inverse p) (at level 3, format "p '^'") : path_scope. -Class IsEquiv {A B : Type} (f : A -> B) := {}. -Axiom path_universe : forall {A B : Type} (f : A -> B) {feq : IsEquiv f}, (A = B). - -Definition Lift : Type@{i} -> Type@{j} - := Eval hnf in let lt := Type@{i} : Type@{j} in fun T => T. - -Definition lift {T} : T -> Lift T := fun x => x. - -Goal forall x y : Type, x = y. - intros. - pose proof ((fun H0 : idmap _ => (@path_universe _ _ (@lift x) (H0 x) @ - (@path_universe _ _ (@lift x) (H0 x))^)))%path as H''. diff --git a/test-suite/bugs/closed/3567.v b/test-suite/bugs/closed/3567.v deleted file mode 100644 index 00c9c05469..0000000000 --- a/test-suite/bugs/closed/3567.v +++ /dev/null @@ -1,68 +0,0 @@ - -(* File reduced by coq-bug-finder from original input, then from 2901 lines to 69 lines, then from 80 lines to 63 lines *) -(* coqc version trunk (September 2014) compiled on Sep 2 2014 2:7:1 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (3c5daf4e23ee20f0788c0deab688af452e83ccf0) *) - -Set Primitive Projections. -Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Arguments fst {A B} _ / . -Arguments snd {A B} _ / . -Add Printing Let prod. -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Unset Implicit Arguments. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := - { equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) }. -Definition path_prod_uncurried {A B : Type} (z z' : A * B) (pq : (fst z = fst z') * (snd z = snd z')) -: (z = z') - := match fst pq in (_ = z'1), snd pq in (_ = z'2) return z = (z'1, z'2) with - | idpath, idpath => idpath - end. -Definition path_prod {A B : Type} (z z' : A * B) : - (fst z = fst z') -> (snd z = snd z') -> (z = z') - := fun p q => path_prod_uncurried z z' (p,q). -Definition path_prod' {A B : Type} {x x' : A} {y y' : B} -: (x = x') -> (y = y') -> ((x,y) = (x',y')) - := fun p q => path_prod (x,y) (x',y') p q. -Axiom ap_fst_path_prod : forall {A B : Type} {z z' : A * B} - (p : fst z = fst z') (q : snd z = snd z'), - ap fst (path_prod _ _ p q) = p. -Axiom ap_snd_path_prod : forall {A B : Type} {z z' : A * B} - (p : fst z = fst z') (q : snd z = snd z'), - ap snd (path_prod _ _ p q) = q. -Axiom eta_path_prod : forall {A B : Type} {z z' : A * B} (p : z = z'), - path_prod _ _(ap fst p) (ap snd p) = p. -Definition isequiv_path_prod {A B : Type} {z z' : A * B} : IsEquiv (path_prod_uncurried z z'). -Proof. - refine (Build_IsEquiv - _ _ _ - (fun r => (ap fst r, ap snd r)) - eta_path_prod - (fun pq => match pq with - | (p,q) => path_prod' - (ap_fst_path_prod p q) (ap_snd_path_prod p q) - end) _). - destruct z as [x y], z' as [x' y']. simpl. -(* Toplevel input, characters 15-50: -Error: Abstracting over the term "z" leads to a term -fun z0 : A * B => -forall x : (fst z0 = fst z') * (snd z0 = snd z'), -eta_path_prod (path_prod_uncurried z0 z' x) = -ap (path_prod_uncurried z0 z') - (let (p, q) as pq - return - ((ap (fst) (path_prod_uncurried z0 z' pq), - ap (snd) (path_prod_uncurried z0 z' pq)) = pq) := x in - path_prod' (ap_fst_path_prod p q) (ap_snd_path_prod p q)) -which is ill-typed. -Reason is: Pattern-matching expression on an object of inductive type prod -has invalid information. - *) diff --git a/test-suite/bugs/closed/3584.v b/test-suite/bugs/closed/3584.v deleted file mode 100644 index 37fe46376e..0000000000 --- a/test-suite/bugs/closed/3584.v +++ /dev/null @@ -1,16 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Definition eta_sigma {A} {P : A -> Type} (u : sigT P) - : existT _ (projT1 u) (projT2 u) = u - := match u with existT _ x y => eq_refl end. (* Toplevel input, characters 0-139: -Error: Pattern-matching expression on an object of inductive type sigT -has invalid information. *) -Definition sum_of_sigT A B (x : sigT (fun b : bool => if b then A else B)) -: A + B - := match x with - | existT _ true a => inl a - | existT _ false b => inr b - end. (* Toplevel input, characters 0-182: -Error: Pattern-matching expression on an object of inductive type sigT -has invalid information. *) diff --git a/test-suite/bugs/closed/3590.v b/test-suite/bugs/closed/3590.v deleted file mode 100644 index 9fded85a8d..0000000000 --- a/test-suite/bugs/closed/3590.v +++ /dev/null @@ -1,12 +0,0 @@ -Set Implicit Arguments. -Record prod A B := pair { fst : A ; snd : B }. -Definition idS := Set. -Goal forall x y : prod Set Set, forall H : fst x = fst y, fst x = fst y. - intros. - change (@fst _ _ ?z) with (@fst Set idS z) at 2. - apply H. -Qed. - -(* Toplevel input, characters 20-58: -Error: Failed to get enough information from the left-hand side to type the -right-hand side. *) diff --git a/test-suite/bugs/closed/3593.v b/test-suite/bugs/closed/3593.v deleted file mode 100644 index 378db68570..0000000000 --- a/test-suite/bugs/closed/3593.v +++ /dev/null @@ -1,10 +0,0 @@ -Set Universe Polymorphism. -Set Printing All. -Set Implicit Arguments. -Record prod A B := pair { fst : A ; snd : B }. -Goal forall x : prod Set Set, let f := @fst _ in f _ x = @fst _ _ x. -simpl; intros. - constr_eq (@fst Set Set x) (fst (A := Set) (B := Set) x). - Fail progress change (@fst Set Set x) with (fst (A := Set) (B := Set) x). - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/3594.v b/test-suite/bugs/closed/3594.v deleted file mode 100644 index 1f86f4bd70..0000000000 --- a/test-suite/bugs/closed/3594.v +++ /dev/null @@ -1,51 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 8752 lines to 735 lines, then from 735 lines to 310 lines, then from 228 lines to 105 lines, then from 98 lines to 41 lines *) -(* coqc version trunk (September 2014) compiled on Sep 6 2014 6:15:6 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (3ea6d6888105edd5139ae0a4d8f8ecdb586aff6c) *) -Notation idmap := (fun x => x). -Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), (forall x, f x = g x) -> f = g. -Local Set Primitive Projections. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Bind Scope category_scope with PreCategory. -Set Implicit Arguments. -Delimit Scope functor_scope with functor. -Record Functor (C D : PreCategory) := {}. -Definition opposite (C : PreCategory) : PreCategory := @Build_PreCategory C (fun s d => morphism C d s). -Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. -Definition oppositeF C D (F : Functor C D) : Functor C^op D^op := Build_Functor (C^op) (D^op). -Local Notation "F ^op" := (oppositeF F) (at level 3, format "F ^op") : functor_scope. -Axiom oppositeF_involutive : forall C D (F : Functor C D), ((F^op)^op)%functor = F. -Local Open Scope functor_scope. -Goal forall C D : PreCategory, - (fun c : Functor C^op D^op => (c^op)^op) = idmap. - intros. - exact (path_forall (fun F : Functor C^op D^op => (F^op)^op) _ (@oppositeF_involutive _ _)). - Undo. - Unset Printing Notations. - Set Debug Unification. -(* Check (eq_refl : Build_PreCategory (opposite D).(object) *) -(* (fun s d : (opposite D).(object) => *) -(* (opposite D).(morphism) d s) = *) -(* @Build_PreCategory D (fun s d => morphism D d s)). *) -(* opposite D). *) - exact (path_forall (fun F => (F^op)^op) _ (@oppositeF_involutive _ _)). -Qed. - (* Toplevel input, characters 22-101: -Error: -In environment -C : PreCategory -D : PreCategory -The term - "path_forall - (fun F : Functor (opposite C) (opposite D) => oppositeF (oppositeF F)) - (fun F : Functor (opposite C) (opposite D) => F) - (oppositeF_involutive (D:=opposite D))" has type - "eq (fun F : Functor (opposite C) (opposite D) => oppositeF (oppositeF F)) - (fun F : Functor (opposite C) (opposite D) => F)" -while it is expected to have type - "eq (fun c : Functor (opposite C) (opposite D) => oppositeF (oppositeF c)) - (fun x : Functor (opposite C) (opposite D) => x)" -(cannot unify "{| - object := opposite D; - morphism := fun s d : opposite D => morphism (opposite D) d s |}" -and "opposite D"). - *) diff --git a/test-suite/bugs/closed/3596.v b/test-suite/bugs/closed/3596.v deleted file mode 100644 index 1ee9a5d8c1..0000000000 --- a/test-suite/bugs/closed/3596.v +++ /dev/null @@ -1,19 +0,0 @@ -Require Import TestSuite.admit. -Set Implicit Arguments. -Record foo := { fx : nat }. -Set Primitive Projections. -Record bar := { bx : nat }. -Definition Foo (f : foo) : f = f. - destruct f as [fx]; destruct fx; admit. -Defined. -Definition Bar (b : bar) : b = b. - destruct b as [fx]; destruct fx; admit. -Defined. -Goal forall f b, Bar b = Bar b -> Foo f = Foo f. - intros f b. - destruct f, b. - simpl. - Fail progress unfold Bar. (* success *) - Fail progress unfold Foo. (* failed to progress *) - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/3612.v b/test-suite/bugs/closed/3612.v deleted file mode 100644 index 33e5d532ad..0000000000 --- a/test-suite/bugs/closed/3612.v +++ /dev/null @@ -1,54 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-indices-matter" "-nois") -*- *) -(* File reduced by coq-bug-finder from original input, then from 3595 lines to 3518 lines, then from 3133 lines to 2950 lines, then from 2911 lines to 415 lines, then from 431 lines to 407 \ -lines, then from 421 lines to 428 lines, then from 444 lines to 429 lines, then from 434 lines to 66 lines, then from 163 lines to 48 lines *) -(* coqc version trunk (September 2014) compiled on Sep 11 2014 14:48:8 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (580b25e05c7cc9e7a31430b3d9edb14ae12b7598) *) -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Reserved Notation "x = y :> T" (at level 70, y at next level, no associativity). -Reserved Notation "x = y" (at level 70, no associativity). -Delimit Scope type_scope with type. -Bind Scope type_scope with Sortclass. -Open Scope type_scope. -Global Set Universe Polymorphism. -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Generalizable All Variables. -Local Set Primitive Projections. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Arguments projT1 {A P} _ / . -Arguments projT2 {A P} _ / . -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation pr1 := projT1. -Notation pr2 := projT2. -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y . -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. -Local Open Scope path_scope. -Axiom pr1_path : forall `{P : A -> Type} {u v : sigT P} (p : u = v), u.1 = v.1. -Notation "p ..1" := (pr1_path p) (at level 3) : fibration_scope. -Axiom pr2_path : forall `{P : A -> Type} {u v : sigT P} (p : u = v), p..1 # u.2 = v.2. -Notation "p ..2" := (pr2_path p) (at level 3) : fibration_scope. -Axiom path_path_sigma : forall {A : Type} (P : A -> Type) (u v : sigT P) - (p q : u = v) - (r : p..1 = q..1) - (s : transport (fun x => transport P x u.2 = v.2) r p..2 = q..2), -p = q. - -Declare ML Module "ltac_plugin". - -Set Default Proof Mode "Classic". - -Goal forall (A : Type) (B : forall _ : A, Type) (x : @sigT A (fun x : A => B x)) - (xx : @paths (@sigT A (fun x0 : A => B x0)) x x), - @paths (@paths (@sigT A (fun x0 : A => B x0)) x x) xx - (@idpath (@sigT A (fun x0 : A => B x0)) x). - intros A B x xx. - Set Printing All. - change (fun x => B x) with B in xx. - pose (path_path_sigma B x x xx) as x''. - clear x''. - Check (path_path_sigma B x x xx). diff --git a/test-suite/bugs/closed/3616.v b/test-suite/bugs/closed/3616.v deleted file mode 100644 index 688700260c..0000000000 --- a/test-suite/bugs/closed/3616.v +++ /dev/null @@ -1,3 +0,0 @@ -(* Was failing from April 2014 to September 2014 because of injection *) -Goal forall P e es t, (e :: es = existT P tt t :: es)%list -> True. -inversion 1. diff --git a/test-suite/bugs/closed/3618.v b/test-suite/bugs/closed/3618.v deleted file mode 100644 index 674b4cc2f4..0000000000 --- a/test-suite/bugs/closed/3618.v +++ /dev/null @@ -1,103 +0,0 @@ -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Notation "x = y" := (@paths _ x y) : type_scope. -Definition concat {A} {x y z : A} : x = y -> y = z -> x = z. Admitted. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x. Admitted. -Notation "p @ q" := (concat p q) (at level 20). -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y. Admitted. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y. Admitted. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : forall x, f (equiv_inv x) = x; - eissect : forall x, equiv_inv (f x) = x -}. - -Class Contr_internal (A : Type). - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. -Definition istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) -: IsTrunc n (x = y). -Admitted. - -Hint Extern 4 (IsTrunc _ (_ = _)) => eapply @istrunc_paths : typeclass_instances. - -Class Funext. - -Instance isequiv_compose A B C f g `{IsEquiv A B f} `{IsEquiv B C g} - : IsEquiv (compose g f) | 1000. -Admitted. - -Section IsEquivHomotopic. - Context (A B : Type) `(f : A -> B) `(g : A -> B) `{IsEquiv A B f} (h : forall x:A, f x = g x). - Let sect := (fun b:B => inverse (h (@equiv_inv _ _ f _ b)) @ @eisretr _ _ f _ b). - Let retr := (fun a:A => inverse (ap (@equiv_inv _ _ f _) (h a)) @ @eissect _ _ f _ a). - Global Instance isequiv_homotopic : IsEquiv g | 10000 - := ( BuildIsEquiv _ _ g (@equiv_inv _ _ f _) sect retr). -End IsEquivHomotopic. - -Instance trunc_succ A n `{IsTrunc n A} : IsTrunc (trunc_S n) A | 1000. Admitted. - -Global Instance trunc_forall A n `{P : A -> Type} `{forall a, IsTrunc n (P a)} - : IsTrunc n (forall a, P a) | 100. -Admitted. - -Instance trunc_prod A B n `{IsTrunc n A} `{IsTrunc n B} : IsTrunc n (A * B) | 100. -Admitted. - -Global Instance trunc_arrow n {A B : Type} `{IsTrunc n B} : IsTrunc n (A -> B) | 100. -Admitted. - -Instance isequiv_pr1_contr {A} {P : A -> Type} `{forall a, IsTrunc minus_two (P a)} -: IsEquiv (@projT1 A P) | 100. -Admitted. - -Instance trunc_sigma n A `{P : A -> Type} `{IsTrunc n A} `{forall a, IsTrunc n (P a)} -: IsTrunc n (sigT P) | 100. -Admitted. - -Global Instance trunc_trunc `{Funext} A m n : IsTrunc (trunc_S n) (IsTrunc m A) | 0. -Admitted. - -Definition BiInv {A B} (f : A -> B) : Type -:= ( {g : B -> A & forall x, g (f x) = x} * {h : B -> A & forall x, f (h x) = x}). - -Global Instance isprop_biinv {A B} (f : A -> B) : IsTrunc (trunc_S minus_two) (BiInv f) | 0. -Admitted. - -Instance isequiv_path {A B : Type} (p : A = B) -: IsEquiv (transport (fun X:Type => X) p) | 0. -Admitted. - -Class ReflectiveSubuniverse_internal := - { inO_internal : Type -> Type ; - O : Type -> Type ; - O_unit : forall T, T -> O T }. - -Class ReflectiveSubuniverse := - ReflectiveSubuniverse_wrap : Funext -> ReflectiveSubuniverse_internal. -Global Existing Instance ReflectiveSubuniverse_wrap. - -Class inO {fs : Funext} {subU : ReflectiveSubuniverse} (T : Type) := - isequiv_inO : inO_internal T. - -Global Instance hprop_inO {fs : Funext} {subU : ReflectiveSubuniverse} (T : Type) : IsTrunc (trunc_S minus_two) (inO T) . -Admitted. - -(* To avoid looping class resolution *) -Hint Mode IsEquiv - - + : typeclass_instances. - -Fail Definition equiv_O_rectnd {fs : Funext} {subU : ReflectiveSubuniverse} - (P Q : Type) {Q_inO : inO_internal Q} -: IsEquiv (fun f : O P -> P => compose f (O_unit P)) := _. diff --git a/test-suite/bugs/closed/3623.v b/test-suite/bugs/closed/3623.v deleted file mode 100644 index 202b900164..0000000000 --- a/test-suite/bugs/closed/3623.v +++ /dev/null @@ -1,4 +0,0 @@ -Require Import List. -Goal (1 :: 2 :: nil) ++ (3::nil) = (1::2::3::nil). -change (@app nat (?a :: ?b) ?c) with (a :: @app nat b c). -Abort. diff --git a/test-suite/bugs/closed/3624.v b/test-suite/bugs/closed/3624.v deleted file mode 100644 index 024243cfd3..0000000000 --- a/test-suite/bugs/closed/3624.v +++ /dev/null @@ -1,11 +0,0 @@ -Set Implicit Arguments. -Module NonPrim. - Class foo (m : Set) := { pf : m = m }. - Notation pf' m := (pf (m := m)). -End NonPrim. - -Module Prim. - Set Primitive Projections. - Class foo (m : Set) := { pf : m = m }. - Notation pf' m := (pf (m:=m)). (* Wrong argument name: m. *) -End Prim. diff --git a/test-suite/bugs/closed/3625.v b/test-suite/bugs/closed/3625.v deleted file mode 100644 index d4b2cc5ccc..0000000000 --- a/test-suite/bugs/closed/3625.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import TestSuite.admit. -Set Implicit Arguments. -Set Primitive Projections. -Record prod A B := pair { fst : A ; snd : B }. - -Goal forall x y : prod Set Set, x.(@fst _ _) = y.(@fst _ _). - intros. - refine (f_equal _ _). - Undo. - apply f_equal. - admit. -Qed. diff --git a/test-suite/bugs/closed/3628.v b/test-suite/bugs/closed/3628.v deleted file mode 100644 index 4001cf7c2b..0000000000 --- a/test-suite/bugs/closed/3628.v +++ /dev/null @@ -1,9 +0,0 @@ -Module NonPrim. - Class AClass := { x : Set }. - Arguments x {AClass}. -End NonPrim. -Module Prim. - Set Primitive Projections. - Class AClass := { x : Set }. - Arguments x {AClass}. -End Prim. diff --git a/test-suite/bugs/closed/3633.v b/test-suite/bugs/closed/3633.v deleted file mode 100644 index 52bb307271..0000000000 --- a/test-suite/bugs/closed/3633.v +++ /dev/null @@ -1,10 +0,0 @@ -Set Typeclasses Strict Resolution. -Class Contr (A : Type) := { center : A }. -Definition foo {A} `{Contr A} : A. -Proof. - apply center. - Undo. - (* Ensure the constraints are solved independently, otherwise a frozen ?A - makes a search for Contr ?A fail when finishing to apply (fun x => x) *) - apply (fun x => x), center. -Qed. diff --git a/test-suite/bugs/closed/3637.v b/test-suite/bugs/closed/3637.v deleted file mode 100644 index 868f45c89a..0000000000 --- a/test-suite/bugs/closed/3637.v +++ /dev/null @@ -1,11 +0,0 @@ - -Set Implicit Arguments. -Set Primitive Projections. -Record prod A B := pair { fst : A ; snd : B }. -Goal forall x y : prod Set Set, fst x = fst y. - intros. - lazymatch goal with - | [ |- context[@fst ?A ?B] ] => pose (@fst A B) as fst'; - progress change (@fst Set Set) with fst' -end. -Abort. diff --git a/test-suite/bugs/closed/3638.v b/test-suite/bugs/closed/3638.v deleted file mode 100644 index 5441fbedce..0000000000 --- a/test-suite/bugs/closed/3638.v +++ /dev/null @@ -1,25 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 7593 lines to 243 lines, then from 256 lines to 102 lines, then from 104 lines to 28 lines *) -(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) -Set Primitive Projections. -Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Class UnitSubuniverse := { O : Type -> Type ; O_unit : forall T, T -> O T }. -Class ReflectiveSubuniverse := { rsubu_usubu : UnitSubuniverse ; O_rectnd : forall {P Q : Type} (f : P -> Q), O P -> Q }. -Global Existing Instance rsubu_usubu. -Context {subU : ReflectiveSubuniverse}. -Goal forall (A B : Type) (x : O A * O B) (x0 : B), - { g : _ & O_rectnd (fun z : A * B => (O_unit (fst z), O_unit (snd z))) - (O_rectnd (fun a : A => O_unit (a, x0)) (fst x)) = - g x0 }. - eexists. - Show Existentials. Set Printing Existential Instances. - match goal with - | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in set (e' := e) - end. - - -(* Toplevel input, characters 15-114: -Anomaly: Bad recursive type. Please report. *) diff --git a/test-suite/bugs/closed/3640.v b/test-suite/bugs/closed/3640.v deleted file mode 100644 index 5dff98ba23..0000000000 --- a/test-suite/bugs/closed/3640.v +++ /dev/null @@ -1,31 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 14990 lines to 70 lines, then from 44 lines to 29 lines *) -(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) -Set Primitive Projections. -Set Implicit Arguments. -Record sigT {A} P := existT { pr1 : A ; pr2 : P pr1 }. -Notation "{ x : A & P }" := (sigT (A := A) (fun x : A => P)) : type_scope. -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'"). -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'"). -Record Equiv A B := { equiv_fun :> A -> B }. -Notation "A <~> B" := (Equiv A B) (at level 85). -Inductive Bool : Type := true | false. -Definition negb (b : Bool) := if b then false else true. -Axiom eval_bool_isequiv : forall (f : Bool -> Bool), f false = negb (f true). -Lemma bool_map_equiv_not_idmap (f : { f : Bool <~> Bool & ~(forall x, f x = x) }) -: forall b, ~(f.1 b = b). -Proof. - intro b. - intro H''. - apply f.2. - intro b'. - pose proof (eval_bool_isequiv f.1) as H. - destruct b', b. - Fail match type of H with - | _ = negb (f.1 true) => fail 1 "no f.1 true" - end. (* Error: No matching clauses for match. *) - destruct (f.1 true). - simpl in *. - Fail match type of H with - | _ = negb ?T => unify T (f.1 true); fail 1 "still has f.1 true" - end. (* Error: Tactic failure: still has f.1 true. *) diff --git a/test-suite/bugs/closed/3641.v b/test-suite/bugs/closed/3641.v deleted file mode 100644 index 730ab3f431..0000000000 --- a/test-suite/bugs/closed/3641.v +++ /dev/null @@ -1,21 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 7593 lines to 243 lines, then from 256 lines to 102 lines, then from\ - 104 lines to 28 lines *) -(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) -Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Class UnitSubuniverse := { O : Type -> Type ; O_unit : forall T, T -> O T }. -Class ReflectiveSubuniverse := { rsubu_usubu : UnitSubuniverse ; O_rectnd : forall {P Q : Type} (f : P -> Q), O P -> Q }. -Global Existing Instance rsubu_usubu. -Context {subU : ReflectiveSubuniverse}. -Goal forall (A B : Type) (x : O A * O B) (x0 : B), - { g : _ & O_rectnd (fun z : A * B => (O_unit (fst z), O_unit (snd z))) - (O_rectnd (fun a : A => O_unit (a, x0)) (fst x)) = - g x0 }. - eexists. - match goal with - | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in pose (e' := e) - end. - Fail change ?g with e'. (* Stack overflow *) diff --git a/test-suite/bugs/closed/3647.v b/test-suite/bugs/closed/3647.v deleted file mode 100644 index e91c004c77..0000000000 --- a/test-suite/bugs/closed/3647.v +++ /dev/null @@ -1,654 +0,0 @@ -Require Import TestSuite.admit. -Require Coq.Setoids.Setoid. - -Axiom BITS : nat -> Set. -Definition n7 := 7. -Definition n15 := 15. -Definition n31 := 31. -Notation n8 := (S n7). -Notation n16 := (S n15). -Notation n32 := (S n31). -Inductive OpSize := OpSize1 | OpSize2 | OpSize4 . -Definition VWORD s := BITS (match s with OpSize1 => n8 | OpSize2 => n16 | OpSize4 => n32 end). -Definition BYTE := VWORD OpSize1. -Definition WORD := VWORD OpSize2. -Definition DWORD := VWORD OpSize4. -Ltac subst_body := - repeat match goal with - | [ H := _ |- _ ] => subst H - end. -Import Coq.Setoids.Setoid. -Class Equiv (A : Type) := equiv : relation A. -Infix "===" := equiv (at level 70, no associativity). -Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. -Definition setoid_resp {T T'} (f : T -> T') `{e : type T} `{e' : type T'} := forall x y, x === y -> f x === f y. -Record morphism T T' `{e : type T} `{e' : type T'} := - mkMorph { - morph :> T -> T'; - morph_resp : setoid_resp morph}. -Arguments mkMorph [T T' e0 e e1 e']. -Infix "-s>" := morphism (at level 45, right associativity). -Section Morphisms. - Context {S T U V} `{eS : type S} `{eT : type T} `{eU : type U} `{eV : type V}. - Global Instance morph_equiv : Equiv (S -s> T). - admit. - Defined. - - Global Instance morph_type : type (S -s> T). - admit. - Defined. - - Program Definition mcomp (f: T -s> U) (g: S -s> T) : (S -s> U) := - mkMorph (fun x => f (g x)) _. - Next Obligation. - admit. - Defined. - -End Morphisms. - -Infix "<<" := mcomp (at level 35). - -Section MorphConsts. - Context {S T U V} `{eS : type S} `{eT : type T} `{eU : type U} `{eV : type V}. - - Definition lift2s (f : S -> T -> U) p q : (S -s> T -s> U) := - mkMorph (fun x => mkMorph (f x) (p x)) q. - -End MorphConsts. -Instance Equiv_PropP : Equiv Prop. -admit. -Defined. - -Section SetoidProducts. - Context {A B : Type} `{eA : type A} `{eB : type B}. - Global Instance Equiv_prod : Equiv (A * B). - admit. - Defined. - - Global Instance type_prod : type (A * B). - admit. - Defined. - - Program Definition mfst : (A * B) -s> A := - mkMorph (fun p => fst p) _. - Next Obligation. - admit. - Defined. - - Program Definition msnd : (A * B) -s> B := - mkMorph (fun p => snd p) _. - Next Obligation. - admit. - Defined. - - Context {C} `{eC : type C}. - - Program Definition mprod (f: C -s> A) (g: C -s> B) : C -s> (A * B) := - mkMorph (fun c => (f c, g c)) _. - Next Obligation. - admit. - Defined. - -End SetoidProducts. - -Section IndexedProducts. - - Record ttyp := {carr :> Type; eqc : Equiv carr; eqok : type carr}. - Global Instance ttyp_proj_eq {A : ttyp} : Equiv A. - admit. - Defined. - Global Instance ttyp_proj_prop {A : ttyp} : type A. - admit. - Defined. - Context {I : Type} {P : I -> ttyp}. - - Global Program Instance Equiv_prodI : Equiv (forall i, P i) := - fun p p' : forall i, P i => (forall i : I, @equiv _ (eqc _) (p i) (p' i)). - - Global Instance type_prodI : type (forall i, P i). - admit. - Defined. - - Program Definition mprojI (i : I) : (forall i, P i) -s> P i := - mkMorph (fun X => X i) _. - Next Obligation. - admit. - Defined. - - Context {C : Type} `{eC : type C}. - - Program Definition mprodI (f : forall i, C -s> P i) : C -s> (forall i, P i) := - mkMorph (fun c i => f i c) _. - Next Obligation. - admit. - Defined. - -End IndexedProducts. - -Section Exponentials. - - Context {A B C D} `{eA : type A} `{eB : type B} `{eC : type C} `{eD : type D}. - - Program Definition comps : (B -s> C) -s> (A -s> B) -s> A -s> C := - lift2s (fun f g => f << g) _ _. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - - Program Definition muncurry (f : A -s> B -s> C) : A * B -s> C := - mkMorph (fun p => f (fst p) (snd p)) _. - Next Obligation. - admit. - Defined. - - Program Definition mcurry (f : A * B -s> C) : A -s> B -s> C := - lift2s (fun a b => f (a, b)) _ _. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - - Program Definition meval : (B -s> A) * B -s> A := - mkMorph (fun p => fst p (snd p)) _. - Next Obligation. - admit. - Defined. - - Program Definition mid : A -s> A := mkMorph (fun x => x) _. - Next Obligation. - admit. - Defined. - - Program Definition mconst (b : B) : A -s> B := mkMorph (fun _ => b) _. - Next Obligation. - admit. - Defined. - -End Exponentials. - -Inductive empty : Set := . -Instance empty_Equiv : Equiv empty. -admit. -Defined. -Instance empty_type : type empty. -admit. -Defined. - -Section Initials. - Context {A} `{eA : type A}. - - Program Definition mzero_init : empty -s> A := mkMorph (fun x => match x with end) _. - Next Obligation. - admit. - Defined. - -End Initials. - -Section Subsetoid. - - Context {A} `{eA : type A} {P : A -> Prop}. - Global Instance subset_Equiv : Equiv {a : A | P a}. - admit. - Defined. - Global Instance subset_type : type {a : A | P a}. - admit. - Defined. - - Program Definition mforget : {a : A | P a} -s> A := - mkMorph (fun x => x) _. - Next Obligation. - admit. - Defined. - - Context {B} `{eB : type B}. - Program Definition minherit (f : B -s> A) (HB : forall b, P (f b)) : B -s> {a : A | P a} := - mkMorph (fun b => exist P (f b) (HB b)) _. - Next Obligation. - admit. - Defined. - -End Subsetoid. - -Section Option. - - Context {A} `{eA : type A}. - Global Instance option_Equiv : Equiv (option A). - admit. - Defined. - - Global Instance option_type : type (option A). - admit. - Defined. - -End Option. - -Section OptDefs. - Context {A B} `{eA : type A} `{eB : type B}. - - Program Definition msome : A -s> option A := mkMorph (fun a => Some a) _. - Next Obligation. - admit. - Defined. - - Program Definition moptionbind (f : A -s> option B) : option A -s> option B := - mkMorph (fun oa => match oa with None => None | Some a => f a end) _. - Next Obligation. - admit. - Defined. - -End OptDefs. - -Generalizable Variables Frm. - -Class ILogicOps Frm := { - lentails: relation Frm; - ltrue: Frm; - lfalse: Frm; - limpl: Frm -> Frm -> Frm; - land: Frm -> Frm -> Frm; - lor: Frm -> Frm -> Frm; - lforall: forall {T}, (T -> Frm) -> Frm; - lexists: forall {T}, (T -> Frm) -> Frm - }. - -Infix "|--" := lentails (at level 79, no associativity). -Infix "//\\" := land (at level 75, right associativity). -Infix "\\//" := lor (at level 76, right associativity). -Infix "-->>" := limpl (at level 77, right associativity). -Notation "'Forall' x .. y , p" := - (lforall (fun x => .. (lforall (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity). -Notation "'Exists' x .. y , p" := - (lexists (fun x => .. (lexists (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity). - -Class ILogic Frm {ILOps: ILogicOps Frm} := { - lentailsPre:> PreOrder lentails; - ltrueR: forall C, C |-- ltrue; - lfalseL: forall C, lfalse |-- C; - lforallL: forall T x (P: T -> Frm) C, P x |-- C -> lforall P |-- C; - lforallR: forall T (P: T -> Frm) C, (forall x, C |-- P x) -> C |-- lforall P; - lexistsL: forall T (P: T -> Frm) C, (forall x, P x |-- C) -> lexists P |-- C; - lexistsR: forall T x (P: T -> Frm) C, C |-- P x -> C |-- lexists P; - landL1: forall P Q C, P |-- C -> P //\\ Q |-- C; - landL2: forall P Q C, Q |-- C -> P //\\ Q |-- C; - lorR1: forall P Q C, C |-- P -> C |-- P \\// Q; - lorR2: forall P Q C, C |-- Q -> C |-- P \\// Q; - landR: forall P Q C, C |-- P -> C |-- Q -> C |-- P //\\ Q; - lorL: forall P Q C, P |-- C -> Q |-- C -> P \\// Q |-- C; - landAdj: forall P Q C, C |-- (P -->> Q) -> C //\\ P |-- Q; - limplAdj: forall P Q C, C //\\ P |-- Q -> C |-- (P -->> Q) - }. -Hint Extern 0 (?x |-- ?x) => reflexivity. - -Section ILogicExtra. - Context `{IL: ILogic Frm}. - Definition lpropand (p: Prop) Q := Exists _: p, Q. - Definition lpropimpl (p: Prop) Q := Forall _: p, Q. - -End ILogicExtra. - -Infix "/\\" := lpropand (at level 75, right associativity). -Infix "->>" := lpropimpl (at level 77, right associativity). - -Section ILogic_Fun. - Context (T: Type) `{TType: type T}. - Context `{IL: ILogic Frm}. - - Record ILFunFrm := mkILFunFrm { - ILFunFrm_pred :> T -> Frm; - ILFunFrm_closed: forall t t': T, t === t' -> - ILFunFrm_pred t |-- ILFunFrm_pred t' - }. - - Notation "'mk'" := @mkILFunFrm. - - Program Definition ILFun_Ops : ILogicOps ILFunFrm := {| - lentails P Q := forall t:T, P t |-- Q t; - ltrue := mk (fun t => ltrue) _; - lfalse := mk (fun t => lfalse) _; - limpl P Q := mk (fun t => P t -->> Q t) _; - land P Q := mk (fun t => P t //\\ Q t) _; - lor P Q := mk (fun t => P t \\// Q t) _; - lforall A P := mk (fun t => Forall a, P a t) _; - lexists A P := mk (fun t => Exists a, P a t) _ - |}. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - -End ILogic_Fun. - -Arguments ILFunFrm _ {e} _ {ILOps}. -Arguments mkILFunFrm [T] _ [Frm ILOps]. - -Program Definition ILFun_eq {T R} {ILOps: ILogicOps R} {ILogic: ILogic R} (P : T -> R) : - @ILFunFrm T _ R ILOps := - @mkILFunFrm T eq R ILOps P _. -Next Obligation. - admit. -Defined. - -Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| - lentails P Q := (P : Prop) -> Q; - ltrue := True; - lfalse := False; - limpl P Q := P -> Q; - land P Q := P /\ Q; - lor P Q := P \/ Q; - lforall T F := forall x:T, F x; - lexists T F := exists x:T, F x - |}. - -Instance ILogic_Prop : ILogic Prop. -admit. -Defined. - -Section FunEq. - Context A `{eT: type A}. - - Global Instance FunEquiv {T} : Equiv (T -> A) := { - equiv P Q := forall a, P a === Q a - }. -End FunEq. - -Section SepAlgSect. - Class SepAlgOps T `{eT : type T}:= { - sa_unit : T; - - sa_mul : T -> T -> T -> Prop - }. - - Class SepAlg T `{SAOps: SepAlgOps T} : Type := { - sa_mul_eqL a b c d : sa_mul a b c -> c === d -> sa_mul a b d; - sa_mul_eqR a b c d : sa_mul a b c -> sa_mul a b d -> c === d; - sa_mon a b c : a === b -> sa_mul a c === sa_mul b c; - sa_mulC a b : sa_mul a b === sa_mul b a; - sa_mulA a b c : forall bc abc, sa_mul a bc abc -> sa_mul b c bc -> - exists ac, sa_mul b ac abc /\ sa_mul a c ac; - sa_unitI a : sa_mul a sa_unit a - }. - -End SepAlgSect. - -Section BILogic. - - Class BILOperators (A : Type) := { - empSP : A; - sepSP : A -> A -> A; - wandSP : A -> A -> A - }. - -End BILogic. - -Notation "a '**' b" := (sepSP a b) - (at level 75, right associativity). - -Section BISepAlg. - Context {A} `{sa : SepAlg A}. - Context {B} `{IL: ILogic B}. - - Program Instance SABIOps: BILOperators (ILFunFrm A B) := { - empSP := mkILFunFrm e (fun x => sa_unit === x /\\ ltrue) _; - sepSP P Q := mkILFunFrm e (fun x => Exists x1, Exists x2, sa_mul x1 x2 x /\\ - P x1 //\\ Q x2) _; - wandSP P Q := mkILFunFrm e (fun x => Forall x1, Forall x2, sa_mul x x1 x2 ->> - P x1 -->> Q x2) _ - }. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - -End BISepAlg. - -Set Implicit Arguments. - -Definition Chan := WORD. -Definition Data := BYTE. - -Inductive Action := -| Out (c:Chan) (d:Data) -| In (c:Chan) (d:Data). - -Definition Actions := list Action. - -Instance ActionsEquiv : Equiv Actions := { - equiv a1 a2 := a1 = a2 - }. - -Definition OPred := ILFunFrm Actions Prop. -Definition mkOPred (P : Actions -> Prop) : OPred. - admit. -Defined. - -Definition eq_opred s := mkOPred (fun s' => s === s'). -Definition empOP : OPred. - exact (eq_opred nil). -Defined. -Definition catOP (P Q: OPred) : OPred. - admit. -Defined. - -Class IsPointed (T : Type) := point : T. - -Generalizable All Variables. - -Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). - -Record PointedOPred := mkPointedOPred { - OPred_pred :> OPred; - OPred_inhabited: IsPointed_OPred OPred_pred - }. - -Existing Instance OPred_inhabited. - -Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred - := {| OPred_pred := O ; OPred_inhabited := _ |}. -Instance IsPointed_eq_opred x : IsPointed_OPred (eq_opred x). -admit. -Defined. -Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q). -admit. -Defined. - -Definition Flag := BITS 5. -Definition OF: Flag. - admit. -Defined. - -Inductive FlagVal := mkFlag (b: bool) | FlagUnspecified. -Coercion mkFlag : bool >-> FlagVal. -Inductive NonSPReg := EAX | EBX | ECX | EDX | ESI | EDI | EBP. - -Inductive Reg := nonSPReg (r: NonSPReg) | ESP. - -Inductive AnyReg := regToAnyReg (r: Reg) | EIP. - -Inductive BYTEReg := AL|BL|CL|DL|AH|BH|CH|DH. - -Inductive WORDReg := mkWordReg (r:Reg). -Definition PState : Type. -admit. -Defined. - -Instance PStateEquiv : Equiv PState. -admit. -Defined. - -Instance PStateType : type PState. -admit. -Defined. - -Instance PStateSepAlgOps: SepAlgOps PState. -admit. -Defined. -Definition SPred : Type. -exact (ILFunFrm PState Prop). -Defined. - -Local Existing Instance ILFun_Ops. -Local Existing Instance SABIOps. -Axiom BYTEregIs : BYTEReg -> BYTE -> SPred. - -Inductive RegOrFlag := -| RegOrFlagDWORD :> AnyReg -> RegOrFlag -| RegOrFlagWORD :> WORDReg -> RegOrFlag -| RegOrFlagBYTE :> BYTEReg -> RegOrFlag -| RegOrFlagF :> Flag -> RegOrFlag. - -Definition RegOrFlag_target rf := - match rf with - | RegOrFlagDWORD _ => DWORD - | RegOrFlagWORD _ => WORD - | RegOrFlagBYTE _ => BYTE - | RegOrFlagF _ => FlagVal - end. - -Inductive Condition := -| CC_O | CC_B | CC_Z | CC_BE | CC_S | CC_P | CC_L | CC_LE. - -Section ILSpecSect. - - Axiom spec : Type. - Global Instance ILOps: ILogicOps spec | 2. - admit. - Defined. - -End ILSpecSect. - -Axiom parameterized_basic : forall {T_OPred} {proj : T_OPred -> OPred} {T} (P : SPred) (c : T) (O : OPred) (Q : SPred), spec. -Global Notation loopy_basic := (@parameterized_basic PointedOPred OPred_pred _). - -Axiom program : Type. - -Axiom ConditionIs : forall (cc : Condition) (cv : RegOrFlag_target OF), SPred. - -Axiom foldl : forall {T R}, (R -> T -> R) -> R -> list T -> R. -Axiom nth : forall {T}, T -> list T -> nat -> T. -Axiom while : forall (ptest: program) - (cond: Condition) (value: bool) - (pbody: program), program. - -Lemma while_rule_ind {quantT} - {ptest} {cond : Condition} {value : bool} {pbody} - {S} - {transition_body : quantT -> quantT} - {P : quantT -> SPred} {Otest : quantT -> OPred} {Obody : quantT -> OPred} {O : quantT -> PointedOPred} - {O_after_test : quantT -> PointedOPred} - {I_state : quantT -> bool -> SPred} - {I_logic : quantT -> bool -> bool} - {Q : quantT -> SPred} - (Htest : S |-- (Forall (x : quantT), - (loopy_basic (P x) - ptest - (Otest x) - (Exists b, I_logic x b = true /\\ I_state x b ** ConditionIs cond b)))) - (Hbody : S |-- (Forall (x : quantT), - (loopy_basic (I_logic x value = true /\\ I_state x value ** ConditionIs cond value) - pbody - (Obody x) - (P (transition_body x))))) - (H_after_test : forall x, catOP (Otest x) (O_after_test x) |-- O x) - (H_body_after_test : forall x, I_logic x value = true -> catOP (Obody x) (O (transition_body x)) |-- O_after_test x) - (H_empty : forall x, I_logic x (negb value) = true -> empOP |-- O_after_test x) - (Q_correct : forall x, I_logic x (negb value) = true /\\ I_state x (negb value) ** ConditionIs cond (negb value) |-- Q x) - (Q_safe : forall x, I_logic x value = true -> Q (transition_body x) |-- Q x) -: S |-- (Forall (x : quantT), - loopy_basic (P x) - (while ptest cond value pbody) - (O x) - (Q x)). -admit. -Defined. -Axiom behead : forall {T}, list T -> list T. -Axiom all : forall {T}, (T -> bool) -> list T -> bool. -Axiom all_behead : forall {T} (xs : list T) P, all P xs = true -> all P (behead xs) = true. -Instance IsPointed_foldlOP A B C f g (init : A * B) `{IsPointed_OPred (g init)} - `{forall a acc, IsPointed_OPred (g acc) -> IsPointed_OPred (g (f acc a))} - (ls : list C) -: IsPointed_OPred (g (foldl f init ls)). -admit. -Defined. -Goal forall (ptest : program) (cond : Condition) (value : bool) - (pbody : program) (T ioT : Type) (P : T -> SPred) - (I : T -> bool -> SPred) (accumulate : T -> ioT -> T) - (Otest Obody : T -> ioT -> PointedOPred) - (coq_test__is_finished : ioT -> bool) (S : spec) - (al : BYTE), - (forall (initial : T) (xs : list ioT) (x : ioT), - all (fun t : ioT => negb (coq_test__is_finished t)) xs = true -> - coq_test__is_finished x = true -> - S - |-- loopy_basic (P initial ** BYTEregIs AL al) ptest - (Otest initial (nth x xs 0)) - (I initial - (match coq_test__is_finished (nth x xs 0) with true => negb value | false => value end) ** - ConditionIs cond - (match coq_test__is_finished (nth x xs 0) with true => negb value | false => value end))) -> - (forall (initial : T) (xs : list ioT) (x : ioT), - all (fun t : ioT => negb (coq_test__is_finished t)) xs = true -> - xs <> nil -> - coq_test__is_finished x = true -> - S - |-- loopy_basic (I initial value ** ConditionIs cond value) pbody - (Obody initial (nth x xs 0)) - (P (accumulate initial (nth x xs 0)) ** BYTEregIs AL al)) -> - forall x : ioT, - coq_test__is_finished x = true -> - S - |-- Forall ixsp : {init_xs : T * list ioT & - all (fun t : ioT => negb (coq_test__is_finished t)) - (snd init_xs) = true}, - loopy_basic (P (fst (projT1 ixsp)) ** BYTEregIs AL al) - (while ptest cond value pbody) - (catOP - (snd - (foldl - (fun (xy : T * OPred) (v : ioT) => - (accumulate (fst xy) v, - catOP (catOP (Otest (fst xy) v) (Obody (fst xy) v)) - (snd xy))) (fst (projT1 ixsp), empOP) - (snd (projT1 ixsp)))) - (Otest (foldl accumulate (fst (projT1 ixsp)) (snd (projT1 ixsp))) - x)) - (I (foldl accumulate (fst (projT1 ixsp)) (snd (projT1 ixsp))) - (negb value) ** ConditionIs cond (negb value)). - intros. - eapply @while_rule_ind - with (I_logic := fun ixsp b => match (match (coq_test__is_finished (nth x (snd (projT1 ixsp)) 0)) with true => negb value | false => value end), b with true, true => true | false, false => true | _, _ => false end) - (Otest := fun ixsp => Otest (fst (projT1 ixsp)) (nth x (snd (projT1 ixsp)) 0)) - (Obody := fun ixsp => Obody (fst (projT1 ixsp)) (nth x (snd (projT1 ixsp)) 0)) - (I_state := fun ixsp => I (fst (projT1 ixsp))) - (transition_body := fun ixsp => let initial := fst (projT1 ixsp) in - let xs := snd (projT1 ixsp) in - existT _ (accumulate initial (nth x xs 0), behead xs) _) - (O_after_test := fun ixsp => let initial := fst (projT1 ixsp) in - let xs := snd (projT1 ixsp) in - match xs with | nil => default_PointedOPred empOP | _ => Obody initial (nth x xs 0) end); - simpl projT1; simpl projT2; simpl fst; simpl snd; clear; let H := fresh in assert (H : False) by (clear; admit); destruct H. - - Grab Existential Variables. - subst_body; simpl. - Fail refine (all_behead (projT2 _)). - Unset Solve Unification Constraints. refine (all_behead (projT2 _)). diff --git a/test-suite/bugs/closed/3648.v b/test-suite/bugs/closed/3648.v deleted file mode 100644 index 58aa161403..0000000000 --- a/test-suite/bugs/closed/3648.v +++ /dev/null @@ -1,83 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 8808 lines to 424 lines, then from 432 lines to 196 lines, then from\ - 145 lines to 82 lines *) -(* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *) - -Reserved Infix "o" (at level 40, left associativity). -Global Set Primitive Projections. - -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. - -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g) - }. -Arguments identity {!C%category} / x%object : rename. - -Infix "o" := (@compose _ _ _ _) : morphism_scope. - -Local Open Scope morphism_scope. -Definition prodC (C D : PreCategory) : PreCategory. - refine (@Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) - * morphism D (snd s) (snd d))%type) - (fun x => (identity (fst x), identity (snd x))) - (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1))). -Defined. - -Local Infix "*" := prodC : category_scope. - -Delimit Scope functor_scope with functor. - -Record Functor (C D : PreCategory) := - { - object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d); - identity_of : forall x, morphism_of _ _ (identity x) - = identity (object_of x) - }. -Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. -Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. -Axiom cheat : forall {A}, A. -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. -Definition functor_category (C D : PreCategory) : PreCategory. - exact (@Build_PreCategory (Functor C D) - (@NaturalTransformation C D) cheat cheat). -Defined. - -Local Notation "C -> D" := (functor_category C D) : category_scope. -Variable C1 : PreCategory. -Variable C2 : PreCategory. -Variable D : PreCategory. - -Definition functor_object_of -: (C1 -> (C2 -> D))%category -> (C1 * C2 -> D)%category. -Proof. - intro F; hnf in F |- *. - refine (Build_Functor - (prodC C1 C2) D - (fun c1c2 => F (fst c1c2) (snd c1c2)) - (fun s d m => F (fst d) _1 (snd m) o (@morphism_of _ _ F _ _ (fst m)) (snd s)) - _). - intros. - rewrite identity_of. - cbn. - rewrite (identity_of _ _ F (fst x)). - Undo. -(* Toplevel input, characters 20-55: -Error: -Found no subterm matching "F _1 (identity (fst x))" in the current goal. *) - rewrite identity_of. (* Toplevel input, characters 15-34: -Error: -Found no subterm matching "morphism_of ?202 (identity ?203)" in the current goal. *) diff --git a/test-suite/bugs/closed/3649.v b/test-suite/bugs/closed/3649.v deleted file mode 100644 index a664a1ef1d..0000000000 --- a/test-suite/bugs/closed/3649.v +++ /dev/null @@ -1,60 +0,0 @@ -(* -*- coq-prog-args: ("-nois") -*- *) -(* File reduced by coq-bug-finder from original input, then from 9518 lines to 404 lines, then from 410 lines to 208 lines, then from 162 lines to 77 lines *) -(* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *) -Declare ML Module "ltac_plugin". -Set Default Proof Mode "Classic". -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Reserved Notation "x = y" (at level 70, no associativity). -Delimit Scope type_scope with type. -Bind Scope type_scope with Sortclass. -Open Scope type_scope. -Axiom admit : forall {T}, T. -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Reserved Infix "o" (at level 40, left associativity). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Global Set Primitive Projections. -Delimit Scope morphism_scope with morphism. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g) }. -Infix "o" := (@compose _ _ _ _) : morphism_scope. -Set Implicit Arguments. -Local Open Scope morphism_scope. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d) }. -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := - { morphism_inverse : morphism C d s }. -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. -Definition composeT C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F') -: NaturalTransformation F F''. - exact admit. -Defined. -Definition functor_category (C D : PreCategory) : PreCategory. - exact (@Build_PreCategory (Functor C D) - (@NaturalTransformation C D) - admit - (@composeT C D)). -Defined. -Goal forall (C D : PreCategory) (G G' : Functor C D) - (T : @NaturalTransformation C D G G') - (H : @IsIsomorphism (@functor_category C D) G G' T) - (x : C), - @paths (morphism D (G x) (G x)) - (@compose D (G x) (G' x) (G x) - ((@morphism_inverse (@functor_category C D) G G' T H) x) - (T x)) (@identity D (G x)). - intros. - (** This [change] succeeded, but did not progress, in 07e4438bd758c2ced8caf09a6961ccd77d84e42b, because [T0 x o T1 x] was not found in the goal *) - let T0 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T0) end in - let T1 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T1) end in - progress change (T0 x o T1 x) with ((fun y => y) (T0 x o T1 x)). diff --git a/test-suite/bugs/closed/3652.v b/test-suite/bugs/closed/3652.v deleted file mode 100644 index 86e061376d..0000000000 --- a/test-suite/bugs/closed/3652.v +++ /dev/null @@ -1,101 +0,0 @@ -Require Setoid. -Require ZArith. -Import ZArith. - -Inductive Erasable(A : Set) : Prop := - erasable: A -> Erasable A. - -Arguments erasable [A] _. - -Hint Constructors Erasable. - -Scheme Erasable_elim := Induction for Erasable Sort Prop. - -Notation "## T" := (Erasable T) (at level 1, format "## T") : Erasable_scope. -Notation "# x" := (erasable x) (at level 1, format "# x") : Erasable_scope. -Open Scope Erasable_scope. - -Axiom Erasable_inj : forall {A : Set}{a b : A}, #a=#b -> a=b. - -Lemma Erasable_rw : forall (A: Set)(a b : A), (#a=#b) <-> (a=b). -Proof. - intros A a b. - split. - - apply Erasable_inj. - - congruence. -Qed. - -Open Scope Z_scope. -Opaque Z.mul. - -Infix "^" := Zpower_nat : Z_scope. - -Notation "f ; v <- x" := (let (v) := x in f) - (at level 199, left associativity) : Erasable_scope. -Notation "f ; < v" := (f ; v <- v) - (at level 199, left associativity) : Erasable_scope. -Notation "f |# v <- x" := (#f ; v <- x) - (at level 199, left associativity) : Erasable_scope. -Notation "f |# < v" := (#f ; < v) - (at level 199, left associativity) : Erasable_scope. - -Ltac name_evars id := - repeat match goal with |- context[?V] => - is_evar V; let H := fresh id in set (H:=V) in * end. - -Lemma Twoto0 : 2^0 = 1. -Proof. compute. reflexivity. Qed. - -Ltac ring_simplify' := rewrite ?Twoto0; ring_simplify. - -Definition mp2a1s(x : Z)(n : nat) := x * 2^n + (2^n-1). - -Hint Unfold mp2a1s. - -Definition zotval(n1s : nat)(is2 : bool)(next_value : Z) : Z := - 2 * mp2a1s next_value n1s + if is2 then 2 else 0. - -Inductive zot'(eis2 : ##bool)(value : ##Z) : Set := -| Zot'(is2 : bool) - (iseq : eis2=#is2) - {next_is2 : ##bool} - (ok : is2=true -> next_is2=#false) - {next_value : ##Z} - (n1s : nat) - (veq : value = (zotval n1s is2 next_value |# Prop. - -Lemma rule{T : Set}{x : T} : Q x <-> P x. admit. Qed. - -Goal forall (T : Set)(x : T), Q x <-> P x. -Proof. -intros T x. -setoid_rewrite rule. -reflexivity. -Qed. diff --git a/test-suite/bugs/closed/3654.v b/test-suite/bugs/closed/3654.v deleted file mode 100644 index 15277235b1..0000000000 --- a/test-suite/bugs/closed/3654.v +++ /dev/null @@ -1,7 +0,0 @@ -Tactic Notation "mysimpl" "in" ne_hyp_list(hyps) := simpl in hyps. - -Goal 0+0=0->0+0=0->0=0. -intros H1 H2. -mysimpl in H1 H2. -match goal with H:0=0 |- _ => exact H end. -Qed. diff --git a/test-suite/bugs/closed/3656.v b/test-suite/bugs/closed/3656.v deleted file mode 100644 index cbd773d079..0000000000 --- a/test-suite/bugs/closed/3656.v +++ /dev/null @@ -1,53 +0,0 @@ -Module A. - Set Primitive Projections. - Record hSet : Type := BuildhSet { setT : Type; iss : True }. - Ltac head_hnf_under_binders x := - match eval hnf in x with - | ?f _ => head_hnf_under_binders f - | (fun y => ?f y) => head_hnf_under_binders f - | ?y => y - end. -Goal forall s : hSet, True. -intros. -let x := head_hnf_under_binders setT in pose x. - -set (foo := eq_refl (@setT )). generalize foo. simpl. cbn. -Abort. -End A. - -Module A'. -Set Universe Polymorphism. - Set Primitive Projections. -Record hSet (A : Type) : Type := BuildhSet { setT : Type; iss : True }. -Ltac head_hnf_under_binders x := - match eval compute in x with - | ?f _ => head_hnf_under_binders f - | (fun y => ?f y) => head_hnf_under_binders f - | ?y => y - end. -Goal forall s : @hSet nat, True. -intros. -let x := head_hnf_under_binders setT in pose x. - -set (foo := eq_refl (@setT nat)). generalize foo. simpl. cbn. -Abort. -End A'. - -Set Primitive Projections. -Record hSet : Type := BuildhSet { setT : Type; iss : True }. -Ltac head_hnf_under_binders x := - match eval hnf in x with - | ?f _ => head_hnf_under_binders f - | (fun y => ?f y) => head_hnf_under_binders f - | ?y => y - end. -Goal setT = setT. - progress unfold setT. (* should not succeed *) - match goal with - | |- (fun h => setT h) = (fun h => setT h) => fail 1 "should not eta-expand" - | _ => idtac - end. (* should not fail *) -Abort. - -Goal forall h, setT h = setT h. -Proof. intro. progress unfold setT. diff --git a/test-suite/bugs/closed/3657.v b/test-suite/bugs/closed/3657.v deleted file mode 100644 index 778fdab190..0000000000 --- a/test-suite/bugs/closed/3657.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Check typing of replaced objects in change - even though the failure - was already a proper error message (but with a helpless content) *) - -Class foo {A} {a : A} := { bar := a; baz : bar = bar }. -Arguments bar {_} _ {_}. -Instance: forall A a, @foo A a. -intros; constructor. -abstract reflexivity. -Defined. -Goal @bar _ Set _ = (@bar _ (fun _ : Set => Set) _) nat. -Proof. - Fail change (bar (fun _ : Set => Set)) with (bar Set). diff --git a/test-suite/bugs/closed/3658.v b/test-suite/bugs/closed/3658.v deleted file mode 100644 index 74f4e82dbb..0000000000 --- a/test-suite/bugs/closed/3658.v +++ /dev/null @@ -1,75 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 12178 lines to 457 lines, then from 500 lines to 147 lines, then from 175 lines to 56 lines *) -(* coqc version trunk (September 2014) compiled on Sep 21 2014 16:34:4 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (eaf864354c3fda9ddc1f03f0b1c7807b6fd44322) *) - -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. -Module NonPrim. - Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center = y) }. - Arguments center A {_} / . - Inductive trunc_index : Type := minus_two | trunc_S (_ : trunc_index). - Notation "-2" := minus_two (at level 0). - Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | -2 => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. - Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. - Notation Contr := (IsTrunc -2). - Hint Extern 0 => progress change Contr_internal with Contr in * : typeclass_instances. - Goal forall (H : Type) (H0 : H -> H -> Type) (H1 : Type) - (H2 : Contr H1) (H3 : H1) (H4 : H1 -> H) - (H5 : H0 (H4 (center H1)) (H4 H3)) - (H6 : H0 (H4 (center H1)) (H4 (center H1))), - transport (fun y : H => H0 (H4 (center H1)) y) (ap H4 (contr H3)) H6 = H5. - intros. - match goal with - | [ |- context[contr (center _)] ] => fail 1 "bad" - | _ => idtac - end. - match goal with - | [ H : _ |- _ ] => destruct (contr H) - end. - match goal with - | [ |- context[contr (center ?x)] ] => fail 1 "bad" x - | _ => idtac - end. - admit. - Defined. -End NonPrim. - -Module Prim. - Set Primitive Projections. - Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center = y) }. - Arguments center A {_} / . - Inductive trunc_index : Type := minus_two | trunc_S (_ : trunc_index). - Notation "-2" := minus_two (at level 0). - Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | -2 => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. - Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. - Notation Contr := (IsTrunc -2). - Hint Extern 0 => progress change Contr_internal with Contr in * : typeclass_instances. - Goal forall (H : Type) (H0 : H -> H -> Type) (H1 : Type) - (H2 : Contr H1) (H3 : H1) (H4 : H1 -> H) - (H5 : H0 (H4 (center H1)) (H4 H3)) - (H6 : H0 (H4 (center H1)) (H4 (center H1))), - transport (fun y : H => H0 (H4 (center H1)) y) (ap H4 (contr H3)) H6 = H5. - intros. - match goal with - | [ |- context[contr (center _)] ] => fail 1 "bad" - | _ => idtac - end. - match goal with - | [ H : _ |- _ ] => destruct (contr H) - end. - match goal with - | [ |- context[contr (center ?x)] ] => fail 1 "bad" x - | _ => idtac - end. (* Error: Tactic failure: bad H1. *) - admit. - Defined. -End Prim. diff --git a/test-suite/bugs/closed/3660.v b/test-suite/bugs/closed/3660.v deleted file mode 100644 index 39eb89c402..0000000000 --- a/test-suite/bugs/closed/3660.v +++ /dev/null @@ -1,28 +0,0 @@ -Require Import TestSuite.admit. -Generalizable All Variables. -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. -Open Scope function_scope. -Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. -Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. -Axiom IsHSet : Type -> Type. -Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} : IsEquiv (compose g f) | 1000. -admit. -Defined. -Set Primitive Projections. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. -Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). -Global Instance isequiv_ap_setT X Y : IsEquiv (@ap _ _ setT X Y). -admit. -Defined. -Local Open Scope equiv_scope. -Axiom equiv_path : forall (A B : Type) (p : A = B), A <~> B. - -Goal forall (C D : hSet), IsEquiv (fun x : C = D => (equiv_path C D (ap setT x))). - intros. - change (IsEquiv (equiv_path C D o @ap _ _ setT C D)). - apply @isequiv_compose; [ | admit ]. - Set Typeclasses Debug. - typeclasses eauto. diff --git a/test-suite/bugs/closed/3661.v b/test-suite/bugs/closed/3661.v deleted file mode 100644 index 1f13ffcf34..0000000000 --- a/test-suite/bugs/closed/3661.v +++ /dev/null @@ -1,88 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 11218 lines to 438 lines, then from 434 lines to 202 lines, then from 140 lines to 94 lines *) -(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Set Implicit Arguments. -Delimit Scope morphism_scope with morphism. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Bind Scope category_scope with PreCategory. -Local Open Scope morphism_scope. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. -Set Primitive Projections. -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. -Unset Primitive Projections. -Class Isomorphic {C : PreCategory} s d := - { morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. -Arguments morphism_inverse {C s d} m {_} / . -Local Notation "m ^-1" := (morphism_inverse m) (at level 3, format "m '^-1'") : morphism_scope. -Definition functor_category (C D : PreCategory) : PreCategory. - exact (@Build_PreCategory (Functor C D) - (@NaturalTransformation C D)). -Defined. -Local Notation "C -> D" := (functor_category C D) : category_scope. -Generalizable All Variables. -Definition isisomorphism_components_of `{@IsIsomorphism (C -> D) F G T} x : IsIsomorphism (T x). -Proof. - constructor. - exact (T^-1 x). -Defined. -Hint Immediate isisomorphism_components_of : typeclass_instances. -Goal forall (x3 x9 : PreCategory) (x12 f0 : Functor x9 x3) - (x35 : @Isomorphic (@functor_category x9 x3) f0 x12) - (x37 : object x9) - (H3 : morphism x3 (@object_of x9 x3 f0 x37) - (@object_of x9 x3 f0 x37)) - (x34 : @Isomorphic (@functor_category x9 x3) x12 f0) - (m : morphism x3 (x12 x37) (f0 x37) -> - morphism x3 (f0 x37) (x12 x37) -> - morphism x3 (f0 x37) (f0 x37)), - @paths - (morphism x3 (@object_of x9 x3 f0 x37) (@object_of x9 x3 f0 x37)) - H3 - (m - (@components_of x9 x3 x12 f0 - (@morphism_inverse (@functor_category x9 x3) f0 x12 - (@morphism_isomorphic (@functor_category x9 x3) f0 x12 x35) - (@isisomorphism_isomorphic (@functor_category x9 x3) f0 x12 - x35)) x37) - (@components_of x9 x3 f0 x12 - (@morphism_inverse (@functor_category x9 x3) x12 f0 - (@morphism_isomorphic (@functor_category x9 x3) x12 f0 x34) - (@isisomorphism_isomorphic (@functor_category x9 x3) x12 f0 - x34)) x37)). - Unset Printing All. - intros. - match goal with - | [ |- context[components_of ?T^-1 ?x] ] - => progress let T1 := constr:(T^-1 x) in - let T2 := constr:((T x)^-1) in - change T1 with T2 || fail 1 "too early" - end. - - Undo. - - match goal with - | [ |- context[components_of ?T^-1 ?x] ] - => progress let T1 := constr:(T^-1 x) in - change T1 with ((T x)^-1) || fail 1 "too early 2" - end. - - Undo. - - match goal with - | [ |- context[components_of ?T^-1 ?x] ] - => progress let T2 := constr:((T x)^-1) in - change (T^-1 x) with T2 - end. (* not convertible *) - -(* - - (@components_of x9 x3 x12 f0 - (@morphism_inverse _ _ _ - (@morphism_isomorphic (functor_category x9 x3) f0 x12 x35) _) x37) - -*) diff --git a/test-suite/bugs/closed/3662.v b/test-suite/bugs/closed/3662.v deleted file mode 100644 index b8754bce98..0000000000 --- a/test-suite/bugs/closed/3662.v +++ /dev/null @@ -1,47 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. -Set Nonrecursive Elimination Schemes. -Record prod A B := pair { fst : A ; snd : B }. -Definition f : Set -> Type := fun x => x. - -Goal (fst (pair (fun x => x + 1) nat) 0) = 0. -compute. -Undo. -cbv. -Undo. -Opaque fst. -cbn. -Transparent fst. -cbn. -Undo. -simpl. -Undo. -Abort. - -Goal f (fst (pair nat nat)) = nat. -compute. - match goal with - | [ |- fst ?x = nat ] => fail 1 "compute failed" - | [ |- nat = nat ] => idtac - end. - reflexivity. -Defined. - -Goal fst (pair nat nat) = nat. - unfold fst. - match goal with - | [ |- fst ?x = nat ] => fail 1 "compute failed" - | [ |- nat = nat ] => idtac - end. - reflexivity. -Defined. - -Lemma eta A B : forall x : prod A B, x = pair (fst x) (snd x). reflexivity. Qed. - -Goal forall x : prod nat nat, fst x = 0. - intros. unfold fst. - Fail match goal with - | [ |- fst ?x = 0 ] => idtac - end. -Abort. - diff --git a/test-suite/bugs/closed/3664.v b/test-suite/bugs/closed/3664.v deleted file mode 100644 index cd1427a143..0000000000 --- a/test-suite/bugs/closed/3664.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Import TestSuite.admit. -Module NonPrim. - Unset Primitive Projections. - Record c := { d : Set }. - Definition a x := d x. - Goal forall x, a x. - intro x. - Fail progress simpl. (* [progress simpl] fails correctly *) - Fail progress cbn. (* [progress cbn] fails correctly *) - admit. - Defined. -End NonPrim. - -Module Prim. - Set Primitive Projections. - Record c := { d : Set }. - Definition a x := d x. - Goal forall x, a x. - intro x. - Fail progress simpl. (* [progress simpl] fails correctly *) - Fail progress cbn. (* [cbn] succeeds incorrectly, giving [d x] *) - admit. - Defined. -End Prim. diff --git a/test-suite/bugs/closed/3665.v b/test-suite/bugs/closed/3665.v deleted file mode 100644 index f6a13596ca..0000000000 --- a/test-suite/bugs/closed/3665.v +++ /dev/null @@ -1,33 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 5449 lines to 44 lines *) -(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 - coqtop version trunk (September 2014) *) -Set Primitive Projections. - -Axiom IsHSet : Type -> Type. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. - -Module withdefault. -Canonical Structure default_HSet := fun T P => (@BuildhSet T P). -Goal forall (z : hSet) (T0 : Type -> Type), - (forall (A : Type) (P : T0 A -> Type) (aa : T0 A), P aa) -> - forall x0 : setT z, Set. - clear; intros z T H. - Set Debug Unification. - Fail refine (H _ _). (* Timeout! *) -Abort. -End withdefault. - -Module withnondefault. -Variable T0 : Type -> Type. -Variable T0hset: forall A, IsHSet (T0 A). - -Canonical Structure nondefault_HSet := fun A =>(@BuildhSet (T0 A) (T0hset A)). -Canonical Structure default_HSet := fun A P =>(@BuildhSet A P). -Goal forall (z : hSet) (T0 : Type -> Type), - (forall (A : Type) (P : T0 A -> Type) (aa : T0 A), P aa) -> - forall x0 : setT z, Set. - clear; intros z T H. - Set Debug Unification. - Fail refine (H _ _). (* Timeout! *) -Abort. -End withnondefault. diff --git a/test-suite/bugs/closed/3666.v b/test-suite/bugs/closed/3666.v deleted file mode 100644 index c7bc2f22a8..0000000000 --- a/test-suite/bugs/closed/3666.v +++ /dev/null @@ -1,51 +0,0 @@ -Unset Strict Universe Declaration. -(* File reduced by coq-bug-finder from original input, then from 11542 lines to 325 lines, then from 347 lines to 56 lines, then from 58 lines to 15 lines *) -(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) - -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). -Inductive V : Type@{U'} := | set {A : Type@{U}} (f : A -> V) : V. -Module NonPrim. - Record hProp := hp { hproptype :> Type ; isp : Set}. - Goal forall (A B : Type) (H_f : A -> V -> hProp) (H_g : B -> V -> hProp) - (C : Type) (h : C -> V) (b : B) (a : A) (c : C), - H_f a (h c) -> H_f a (h c) = H_g b (h c) -> H_g b (h c). - intros A B H_f H_g C h b a c H3 H'. - exact (@transport hProp (fun x => x) _ _ H' H3). - Undo. - Set Debug Unification. - exact (H' # H3). - Defined. -End NonPrim. - -Module Prim. - Set Primitive Projections. - Set Universe Polymorphism. - Record hProp := hp { hproptype :> Type ; isp : Set}. - Goal forall (A B : Type) (H_f : A -> V -> hProp) (H_g : B -> V -> hProp) - (C : Type) (h : C -> V) (b : B) (a : A) (c : C), - H_f a (h c) -> H_f a (h c) = H_g b (h c) -> H_g b (h c). - intros A B H_f H_g C h b a c H3 H'. - exact (@transport hProp (fun x => x) _ _ H' H3). - Undo. - Set Debug Unification. - exact (H' # H3). - (* Toplevel input, characters 7-14: -Error: -In environment -A : Type -B : Type -H_f : A -> V -> hProp -H_g : B -> V -> hProp -C : Type -h : C -> V -b : B -a : A -c : C -H3 : H_f a (h c) -H' : H_f a (h c) = H_g b (h c) -Unable to unify "hproptype (H_f a (h c))" with "?T (H_f a (h c))". - *) - Defined. -End Prim. diff --git a/test-suite/bugs/closed/3667.v b/test-suite/bugs/closed/3667.v deleted file mode 100644 index d2fc4d9bf9..0000000000 --- a/test-suite/bugs/closed/3667.v +++ /dev/null @@ -1,25 +0,0 @@ - -Set Primitive Projections. -Axiom ap10 : forall {A B} {f g:A->B} (h:f=g) x, f x = g x. -Axiom IsHSet : Type -> Type. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. -Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d) }. -Set Implicit Arguments. -Record NaturalTransformation C D (F G : Functor C D) := - { components_of :> forall c, morphism D (F c) (G c); - commutes : forall s d (m : morphism C s d), components_of s = components_of s }. -Definition set_cat : PreCategory. - exact ((@Build_PreCategory hSet - (fun x y => x -> y))). -Defined. -Goal forall (A : PreCategory) (F : Functor A set_cat) - (a : A) (x : F a) (nt :NaturalTransformation F F), x = x. - intros. - pose (fun c d m => ap10 (commutes nt c d m)). - - diff --git a/test-suite/bugs/closed/3668.v b/test-suite/bugs/closed/3668.v deleted file mode 100644 index 1add3dba1e..0000000000 --- a/test-suite/bugs/closed/3668.v +++ /dev/null @@ -1,54 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 6329 lines to 110 lines, then from 115 lines to 88 lines, then from 93 lines to 72 lines *) -(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) - -Notation "( x ; y )" := (existT _ x y). -Notation "x .1" := (projT1 x) (at level 3, format "x '.1'"). -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. -Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Notation "A <~> B" := (Equiv A B) (at level 85). -Axiom IsHProp : Type -> Type. -Inductive Bool := true | false. -Definition negb (b : Bool) := if b then false else true. -Hypothesis LEM : forall A : Type, IsHProp A -> A + (A -> False). -Axiom cheat : forall {A},A. -Module NonPrim. - Class Contr (A : Type) := { center : A ; contr : (forall y : A, center = y) }. - Definition Book_6_9 : forall X, X -> X. - Proof. - intro X. - pose proof (@LEM (Contr { f : X <~> X & ~(forall x, f x = x) }) cheat) as contrXEquiv. - destruct contrXEquiv as [[f H]|H]; [ exact f.1 | exact (fun x => x) ]. - Defined. - Lemma Book_6_9_not_id b : Book_6_9 Bool b = negb b. - Proof. - unfold Book_6_9. - destruct (@LEM (Contr { f : Bool <~> Bool & ~(forall x, f x = x) }) _) as [[f H']|H']. - match goal with - | [ |- equiv_fun Bool Bool f.1 b = negb b ] => idtac - | [ |- equiv_fun Bool Bool center.1 b = negb b ] => fail 1 "bad" - end. - all:admit. - Defined. -End NonPrim. -Module Prim. - Set Primitive Projections. - Class Contr (A : Type) := { center : A ; contr : (forall y : A, center = y) }. - Definition Book_6_9 : forall X, X -> X. - Proof. - intro X. - pose proof (@LEM (Contr { f : X <~> X & ~(forall x, f x = x) }) cheat) as contrXEquiv. - destruct contrXEquiv as [[f H]|H]; [ exact (f.1) | exact (fun x => x) ]. - Defined. - Lemma Book_6_9_not_id b : Book_6_9 Bool b = negb b. - Proof. - unfold Book_6_9. - destruct (@LEM (Contr { f : Bool <~> Bool & ~(forall x, f x = x) }) _) as [[f H']|H']. - match goal with - | [ |- equiv_fun Bool Bool f.1 b = negb b ] => idtac - | [ |- equiv_fun Bool Bool center.1 b = negb b ] => fail 1 "bad" - end. (* Tactic failure: bad *) - all:admit. - Defined. -End Prim. diff --git a/test-suite/bugs/closed/3670.v b/test-suite/bugs/closed/3670.v deleted file mode 100644 index c0f03261a9..0000000000 --- a/test-suite/bugs/closed/3670.v +++ /dev/null @@ -1,23 +0,0 @@ -Set Universe Polymorphism. -Module Type FOO. - Parameter f : Type -> Type. - Parameter h : forall T, f T. -End FOO. - -Module Type BAR. - Include FOO. -End BAR. - -Module Type BAZ. - Include FOO. -End BAZ. - -Module BAR_FROM_BAZ (baz : BAZ) <: BAR. - - Definition f : Type -> Type. - Proof. exact baz.f. Defined. - - Definition h : forall T, f T. - Admitted. - -Fail End BAR_FROM_BAZ. diff --git a/test-suite/bugs/closed/3672.v b/test-suite/bugs/closed/3672.v deleted file mode 100644 index b355e7e9db..0000000000 --- a/test-suite/bugs/closed/3672.v +++ /dev/null @@ -1,27 +0,0 @@ -Set Primitive Projections. (* No failures without this option. *) - -Record AT := -{ atype :> Type -; coerce : atype -> Type -}. -Coercion coerce : atype >-> Sortclass. - -Record Ar C (A:AT) := { ar : forall (X Y : C), A }. - -Definition t := forall C A a X, coerce _ (ar C A a X X). -Definition t' := forall C A a X, ar C A a X X. - -(* The command has indeed failed with message: -=> Error: The term "ar C A a X X" has type "atype A" which is not a (co-)inductive type. -*) - -Record Ar2 C (A:AT) := -{ ar2 : forall (X Y : C), A -; id2 : forall X, coerce _ (ar2 X X) }. - -Record Ar3 C (A:AT) := -{ ar3 : forall (X Y : C), A -; id3 : forall X, ar3 X X }. -(* The command has indeed failed with message: -=> Anomaly: Bad recursive type. Please report. -*) diff --git a/test-suite/bugs/closed/3675.v b/test-suite/bugs/closed/3675.v deleted file mode 100644 index 93227ab852..0000000000 --- a/test-suite/bugs/closed/3675.v +++ /dev/null @@ -1,20 +0,0 @@ -Set Primitive Projections. -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. -Notation "p @ q" := (concat p q) (at level 20) : path_scope. -Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : forall x, f (equiv_inv x) = x }. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. -Local Open Scope path_scope. -Local Open Scope equiv_scope. -Generalizable Variables A B C f g. -Lemma isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} -: IsEquiv (compose g f). -Proof. - refine (Build_IsEquiv A C - (compose g f) - (compose f^-1 g^-1) _). - exact (fun c => ap g (@eisretr _ _ f _ (g^-1 c)) @ (@eisretr _ _ g _ c)). diff --git a/test-suite/bugs/closed/3681.v b/test-suite/bugs/closed/3681.v deleted file mode 100644 index 194113c6ed..0000000000 --- a/test-suite/bugs/closed/3681.v +++ /dev/null @@ -1,20 +0,0 @@ -Module Type FOO. - Parameters P Q : Type -> Type. -End FOO. - -Module Type BAR. - Declare Module Import foo : FOO. - Parameter f : forall A, P A -> Q A -> A. -End BAR. - -Module Type BAZ. - Declare Module Export foo : FOO. - Parameter g : forall A, P A -> Q A -> A. -End BAZ. - -Module BAR_FROM_BAZ (baz : BAZ) : BAR. - Import baz. - Module foo <: FOO := foo. - Import foo. - Definition f : forall A, P A -> Q A -> A := g. -End BAR_FROM_BAZ. diff --git a/test-suite/bugs/closed/3682.v b/test-suite/bugs/closed/3682.v deleted file mode 100644 index 9d37d1a2d0..0000000000 --- a/test-suite/bugs/closed/3682.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import TestSuite.admit. -Class Foo. -Definition bar `{Foo} (x : Set) := Set. -Instance: Foo. -Definition bar1 := bar nat. -Definition bar2 := bar ltac:(admit). diff --git a/test-suite/bugs/closed/3684.v b/test-suite/bugs/closed/3684.v deleted file mode 100644 index 130d57779d..0000000000 --- a/test-suite/bugs/closed/3684.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Import TestSuite.admit. -Definition foo : Set. -Proof. - refine (ltac:(abstract admit)). -Qed. diff --git a/test-suite/bugs/closed/3685.v b/test-suite/bugs/closed/3685.v deleted file mode 100644 index 7a0c3e6f1d..0000000000 --- a/test-suite/bugs/closed/3685.v +++ /dev/null @@ -1,75 +0,0 @@ -Require Import TestSuite.admit. -Set Universe Polymorphism. -Class Funext := { }. -Delimit Scope category_scope with category. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Set Implicit Arguments. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); - identity_of : forall s m, morphism_of s s m = morphism_of s s m }. -Definition sub_pre_cat `{Funext} (P : PreCategory -> Type) : PreCategory. -Proof. - exact (@Build_PreCategory PreCategory Functor). -Defined. -Definition opposite (C : PreCategory) : PreCategory. -Proof. - exact (@Build_PreCategory C (fun s d => morphism C d s)). -Defined. -Local Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. -Definition prod (C D : PreCategory) : PreCategory. -Proof. - refine (@Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) * morphism D (snd s) (snd d))%type)). -Defined. -Local Infix "*" := prod : category_scope. -Record NaturalTransformation C D (F G : Functor C D) := {}. -Definition functor_category (C D : PreCategory) : PreCategory. -Proof. - exact (@Build_PreCategory (Functor C D) (@NaturalTransformation C D)). -Defined. -Local Notation "C -> D" := (functor_category C D) : category_scope. -Module Export PointwiseCore. - Local Open Scope category_scope. - Definition pointwise - (C C' : PreCategory) - (F : Functor C' C) - (D D' : PreCategory) - (G : Functor D D') - : Functor (C -> D) (C' -> D'). - Proof. - unshelve (refine (Build_Functor - (C -> D) (C' -> D') - _ - _ - _)); - abstract admit. - Defined. -End PointwiseCore. -Axiom Pidentity_of : forall (C D : PreCategory) (F : Functor C C) (G : Functor D D), pointwise F G = pointwise F G. -Local Open Scope category_scope. -Module Success. - Definition functor_uncurried `{Funext} (P : PreCategory -> Type) - (has_functor_categories : forall C D : sub_pre_cat P, P (C -> D)) - : object (((sub_pre_cat P)^op * (sub_pre_cat P)) -> (sub_pre_cat P)) - := Eval cbv zeta in - let object_of := (fun CD => (((fst CD) -> (snd CD)))) - in Build_Functor - ((sub_pre_cat P)^op * (sub_pre_cat P)) (sub_pre_cat P) - object_of - (fun CD C'D' FG => pointwise (fst FG) (snd FG)) - (fun _ _ => @Pidentity_of _ _ _ _). -End Success. -Module Bad. - Include PointwiseCore. - Definition functor_uncurried `{Funext} (P : PreCategory -> Type) - (has_functor_categories : forall C D : sub_pre_cat P, P (C -> D)) - : object (((sub_pre_cat P)^op * (sub_pre_cat P)) -> (sub_pre_cat P)) - := Eval cbv zeta in - let object_of := (fun CD => (((fst CD) -> (snd CD)))) - in Build_Functor - ((sub_pre_cat P)^op * (sub_pre_cat P)) (sub_pre_cat P) - object_of - (fun CD C'D' FG => pointwise (fst FG) (snd FG)) - (fun _ _ => @Pidentity_of _ _ _ _). diff --git a/test-suite/bugs/closed/3686.v b/test-suite/bugs/closed/3686.v deleted file mode 100644 index df5f667480..0000000000 --- a/test-suite/bugs/closed/3686.v +++ /dev/null @@ -1,63 +0,0 @@ -Require Import TestSuite.admit. -Set Universe Polymorphism. -Set Implicit Arguments. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Bind Scope category_scope with PreCategory. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); - identity_of : forall s m, morphism_of s s m = morphism_of s s m }. -Definition sub_pre_cat (P : PreCategory -> Type) : PreCategory. -Proof. - exact (@Build_PreCategory PreCategory Functor). -Defined. -Definition opposite (C : PreCategory) : PreCategory. -Proof. - exact (@Build_PreCategory C (fun s d => morphism C d s)). -Defined. -Local Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. -Definition prod (C D : PreCategory) : PreCategory. -Proof. - refine (@Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) * morphism D (snd s) (snd d))%type)). -Defined. -Local Infix "*" := prod : category_scope. -Axiom functor_category : PreCategory -> PreCategory -> PreCategory. -Local Notation "C -> D" := (functor_category C D) : category_scope. -Module Export PointwiseCore. - Definition pointwise - (C C' : PreCategory) - (F : Functor C' C) - (D D' : PreCategory) - (G : Functor D D') - : Functor (C -> D) (C' -> D'). - Proof. - unshelve (refine (Build_Functor - (C -> D) (C' -> D') - _ - _ - _)); - abstract admit. - Defined. -End PointwiseCore. -Axiom Pidentity_of : forall (C D : PreCategory) (F : Functor C C) (G : Functor D D), pointwise F G = pointwise F G. -Local Open Scope category_scope. -Definition functor_uncurried (P : PreCategory -> Type) - (has_functor_categories : forall C D : @sub_pre_cat P, P (C -> D)) -: object (((@sub_pre_cat P)^op * (@sub_pre_cat P)) -> (@sub_pre_cat P)). -Proof. - pose (let object_of := (fun CD => (((fst CD) -> (snd CD)))) - in Build_Functor - ((@sub_pre_cat P)^op * (@sub_pre_cat P)) (@sub_pre_cat P) - object_of - (fun CD C'D' FG => pointwise (fst FG) (snd FG)) - (fun _ _ => Pidentity_of _ _)) || fail "early". - Include PointwiseCore. - pose (let object_of := (fun CD => (((fst CD) -> (snd CD)))) - in Build_Functor - ((@sub_pre_cat P)^op * (@sub_pre_cat P)) (@sub_pre_cat P) - object_of - (fun CD C'D' FG => pointwise (fst FG) (snd FG)) - (fun _ _ => Pidentity_of _ _)). -Abort. diff --git a/test-suite/bugs/closed/3690.v b/test-suite/bugs/closed/3690.v deleted file mode 100644 index fa30132ab5..0000000000 --- a/test-suite/bugs/closed/3690.v +++ /dev/null @@ -1,48 +0,0 @@ -Unset Strict Universe Declaration. -Set Printing Universes. -Set Universe Polymorphism. -Definition foo (a := Type) (b := Type) (c := Type) := Type. -Print foo. -(* foo@{Top.2 Top.3 Top.5 Top.6 Top.8 Top.9 Top.10} = -let a := Type@{Top.2} in let b := Type@{Top.5} in let c := Type@{Top.8} in Type@{Top.10} - : Type@{Top.10+1} -(* Top.2 Top.3 Top.5 Top.6 Top.8 Top.9 Top.10 |= Top.2 < Top.3 - Top.5 < Top.6 - Top.8 < Top.9 - *) - *) -Check @foo. (* foo@{Top.11 Top.12 Top.13 Top.14 Top.15 Top.16 -Top.17} - : Type@{Top.17+1} -(* Top.11 Top.12 Top.13 Top.14 Top.15 Top.16 Top.17 |= Top.11 < Top.12 - Top.13 < Top.14 - Top.15 < Top.16 - *) - *) -Definition bar := ltac:(let t := eval compute in foo in exact t). -Check @bar. (* bar@{Top.27} - : Type@{Top.27+1} -(* Top.27 |= *) *) - -Check @bar@{i}. -Definition baz (a := Type) (b := Type : a) (c := Type : b) := a -> c. -Definition qux := Eval compute in baz. -Check @qux. (* qux@{Top.38 Top.39 Top.40 -Top.41} - : Type@{max(Top.38+1, Top.41+1)} -(* Top.38 Top.39 Top.40 Top.41 |= Top.38 < Top.39 - Top.40 < Top.38 - Top.41 < Top.40 - *) *) -Print qux. (* qux@{Top.34 Top.35 Top.36 Top.37} = -Type@{Top.34} -> Type@{Top.37} - : Type@{max(Top.34+1, Top.37+1)} -(* Top.34 Top.35 Top.36 Top.37 |= Top.34 < Top.35 - Top.36 < Top.34 - Top.37 < Top.36 - *) *) -Fail Check @qux@{Set Set}. -Check @qux@{Type Type Type Type}. -(* [qux] should only need two universes *) -Check @qux@{i j k l}. (* Error: The command has not failed!, but I think this is suboptimal *) -Fail Check @qux@{i j}. diff --git a/test-suite/bugs/closed/3692.v b/test-suite/bugs/closed/3692.v deleted file mode 100644 index 72973a8d81..0000000000 --- a/test-suite/bugs/closed/3692.v +++ /dev/null @@ -1,26 +0,0 @@ -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Reserved Notation "x = y" (at level 70, no associativity). -Reserved Notation "x * y" (at level 40, left associativity). -Delimit Scope core_scope with core. -Open Scope core_scope. -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Global Set Primitive Projections. -Global Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'"). -Generalizable Variables X A B f g n. -Axiom path_prod' : forall {A B : Type} {x x' : A} {y y' : B}, (x = x') -> (y = y') -> ((x,y) = (x',y')). -Definition functor_prod {A A' B B' : Type} (f:A->A') (g:B->B') -: A * B -> A' * B'. - exact (fun z => (f (fst z), g (snd z))). -Defined. -Definition isequiv_functor_prod `{IsEquiv A A' f} `{IsEquiv B B' g} -: IsEquiv (functor_prod f g) - := @Build_IsEquiv - _ _ (functor_prod f g) (functor_prod f^-1 g^-1) - (fun z => path_prod' (@eisretr _ _ f _ (fst z)) (@eisretr _ _ g _ (snd z))). diff --git a/test-suite/bugs/closed/3698.v b/test-suite/bugs/closed/3698.v deleted file mode 100644 index 3882eee97c..0000000000 --- a/test-suite/bugs/closed/3698.v +++ /dev/null @@ -1,26 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 5479 lines to 4682 lines, then from 4214 lines to 86 lines, then from 60 lines to 25 lines *) -(* coqc version trunk (October 2014) compiled on Oct 1 2014 18:13:54 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (68846802a7be637ec805a5e374655a426b5723a5) *) -Set Primitive Projections. -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation pr1 := projT1. -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. -Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Global Existing Instance equiv_isequiv. -Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. -Axiom IsHSet : Type -> Type. -Local Open Scope equiv_scope. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. -Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). -Axiom issig_hSet: (sigT IsHSet) <~> hSet. -Definition isequiv_ap_setT X Y : IsEquiv (@ap _ _ setT X Y). -Proof. - assert (H'' : forall g : X = Y -> (issig_hSet^-1 X).1 = (issig_hSet^-1 Y).1, - g = g -> IsEquiv g) by admit. - Eval compute in (@projT1 Type IsHSet (@equiv_inv _ _ _ (equiv_isequiv _ _ issig_hSet) X)). - Fail apply H''. (* stack overflow *) diff --git a/test-suite/bugs/closed/3699.v b/test-suite/bugs/closed/3699.v deleted file mode 100644 index dbb10f94f2..0000000000 --- a/test-suite/bugs/closed/3699.v +++ /dev/null @@ -1,159 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 9593 lines to 104 lines, then from 187 lines to 103 lines, then from 113 lines to 90 lines *) -(* coqc version trunk (October 2014) compiled on Oct 1 2014 18:13:54 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (68846802a7be637ec805a5e374655a426b5723a5) *) -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Inductive trunc_index := minus_two | trunc_S (_ : trunc_index). -Axiom IsTrunc : trunc_index -> Type -> Type. -Existing Class IsTrunc. -Axiom Contr : Type -> Type. -Inductive Trunc (n : trunc_index) (A :Type) : Type := tr : A -> Trunc n A. -Module NonPrim. - Unset Primitive Projections. - Set Implicit Arguments. - Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. - Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. - Unset Implicit Arguments. - Notation "( x ; y )" := (existT _ x y) : fibration_scope. - Open Scope fibration_scope. - Notation pr1 := projT1. - Notation pr2 := projT2. - Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. - Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. - Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. - Class IsConnected (n : trunc_index) (A : Type) := isconnected_contr_trunc :> Contr (Trunc n A). - Axiom isconnected_elim : forall {n} {A} `{IsConnected n A} - (C : Type) `{IsTrunc n C} (f : A -> C), - { c:C & forall a:A, f a = c }. - Class IsConnMap (n : trunc_index) {A B : Type} (f : A -> B) - := isconnected_hfiber_conn_map :> forall b:B, IsConnected n (hfiber f b). - Definition conn_map_elim {n : trunc_index} - {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} - (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} - (d : forall a:A, P (f a)) - : forall b:B, P b. - Proof. - intros b. - unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). - intro x. - exact (transport P x.2 (d x.1)). - Defined. - - Definition conn_map_elim' {n : trunc_index} - {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} - (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} - (d : forall a:A, P (f a)) - : forall b:B, P b. - Proof. - intros b. - unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). - intros [a p]. - exact (transport P p (d a)). - Defined. - - Definition conn_map_comp {n : trunc_index} - {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} - (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} - (d : forall a:A, P (f a)) - : forall a:A, conn_map_elim f P d (f a) = d a /\ conn_map_elim' f P d (f a) = d a. - Proof. - intros a. - unfold conn_map_elim, conn_map_elim'. - Set Printing Coercions. - set (fibermap := fun a0p : hfiber f (f a) - => let (a0, p) := a0p in transport P p (d a0)). - Set Printing Implicit. - let G := match goal with |- ?G => constr:(G) end in - first [ match goal with - | [ |- (@isconnected_elim n (@hfiber A B f (f a)) - (@isconnected_hfiber_conn_map n A B f H (f a)) - (P (f a)) (HP (f a)) - (fun x : @hfiber A B f (f a) => - @transport B P (f x.1) (f a) x.2 (d x.1))).1 = - d a /\ _ ] => idtac - end - | fail 1 "projection names should be folded, [let] should generate unfolded projections, goal:" G ]; - first [ match goal with - | [ |- _ /\ (@isconnected_elim n (@hfiber A B f (f a)) - (@isconnected_hfiber_conn_map n A B f H (f a)) - (P (f a)) (HP (f a)) fibermap).1 = d a ] => idtac - end - | fail 1 "destruct should generate unfolded projections, as should [let], goal:" G ]. - admit. - Defined. -End NonPrim. - -Module Prim. - Set Primitive Projections. - Set Implicit Arguments. - Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. - Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. - Unset Implicit Arguments. - Notation "( x ; y )" := (existT _ x y) : fibration_scope. - Open Scope fibration_scope. - Notation pr1 := projT1. - Notation pr2 := projT2. - Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. - Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. - Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. - Class IsConnected (n : trunc_index) (A : Type) := isconnected_contr_trunc :> Contr (Trunc n A). - Axiom isconnected_elim : forall {n} {A} `{IsConnected n A} - (C : Type) `{IsTrunc n C} (f : A -> C), - { c:C & forall a:A, f a = c }. - Class IsConnMap (n : trunc_index) {A B : Type} (f : A -> B) - := isconnected_hfiber_conn_map :> forall b:B, IsConnected n (hfiber f b). - Definition conn_map_elim {n : trunc_index} - {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} - (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} - (d : forall a:A, P (f a)) - : forall b:B, P b. - Proof. - intros b. - unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). - intro x. - exact (transport P x.2 (d x.1)). - Defined. - - Definition conn_map_elim' {n : trunc_index} - {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} - (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} - (d : forall a:A, P (f a)) - : forall b:B, P b. - Proof. - intros b. - unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). - intros [a p]. - exact (transport P p (d a)). - Defined. - - Definition conn_map_comp {n : trunc_index} - {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} - (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} - (d : forall a:A, P (f a)) - : forall a:A, conn_map_elim f P d (f a) = d a /\ conn_map_elim' f P d (f a) = d a. - Proof. - intros a. - unfold conn_map_elim, conn_map_elim'. - Set Printing Coercions. - set (fibermap := fun a0p : hfiber f (f a) - => let (a0, p) := a0p in transport P p (d a0)). - Set Printing Implicit. - let G := match goal with |- ?G => constr:(G) end in - first [ match goal with - | [ |- (@isconnected_elim n (@hfiber A B f (f a)) - (@isconnected_hfiber_conn_map n A B f H (f a)) - (P (f a)) (HP (f a)) - (fun x : @hfiber A B f (f a) => - @transport B P (f x.1) (f a) x.2 (d x.1))).1 = - d a /\ _ ] => idtac - end - | fail 1 "projection names should be folded, [let] should generate unfolded projections, goal:" G ]; - first [ match goal with - | [ |- _ /\ (@isconnected_elim n (@hfiber A B f (f a)) - (@isconnected_hfiber_conn_map n A B f H (f a)) - (P (f a)) (HP (f a)) fibermap).1 = d a ] => idtac - end - | fail 1 "destruct should generate unfolded projections, as should [let], goal:" G ]. - admit. - Defined. -End Prim. diff --git a/test-suite/bugs/closed/3700.v b/test-suite/bugs/closed/3700.v deleted file mode 100644 index bac443e337..0000000000 --- a/test-suite/bugs/closed/3700.v +++ /dev/null @@ -1,84 +0,0 @@ - -Set Implicit Arguments. -Module NonPrim. - Unset Primitive Projections. - Record prod A B := pair { fst : A ; snd : B }. -End NonPrim. -Module Prim. - Set Primitive Projections. - Record prod A B := pair { fst : A ; snd : B }. -End Prim. -Goal (forall x : NonPrim.prod Set Set, let (a, b) := x in a = a) -/\ (forall x : Prim.prod Set Set, let (a, b) := x in a = a). - Show. (* (forall x : NonPrim.prod Set Set, let (a, _) := x in a = a) /\ - (forall x : Prim.prod Set Set, - let a := Prim.fst x in let b := Prim.snd x in a = a) *) - Set Printing All. - Show. (* and - (forall x : NonPrim.prod Set Set, - match x return Prop with - | NonPrim.pair a _ => @eq Set a a - end) - (forall x : Prim.prod Set Set, - let a := @Prim.fst Set Set x in - let b := @Prim.snd Set Set x in @eq Set a a) *) - Unset Printing All. -Abort. -Goal (forall x : NonPrim.prod Set Set, match x with NonPrim.pair a b => a = a end) -/\ (forall x : Prim.prod Set Set, match x with Prim.pair a b => a = a end). - Show. (* (forall x : NonPrim.prod Set Set, - match x with - | {| NonPrim.fst := a |} => a = a - end) /\ (forall x : Prim.prod Set Set, Prim.fst x = Prim.fst x) *) - (** Wrong: [match] should generate unfolded things *) - Set Printing All. - Show. (* and - (forall x : NonPrim.prod Set Set, - match x return Prop with - | NonPrim.pair a _ => @eq Set a a - end) - (forall x : Prim.prod Set Set, - @eq Set (@Prim.fst Set Set x) (@Prim.fst Set Set x)) *) - Unset Printing All. -Abort. -Goal (forall x : NonPrim.prod Set Set, let (a, b) := x in a = a /\ b = b) -/\ (forall x : Prim.prod Set Set, let (a, b) := x in a = a /\ b = b). - Show. (* (forall x : NonPrim.prod Set Set, let (a, b) := x in a = a /\ b = b) /\ - (forall x : Prim.prod Set Set, - let a := Prim.fst x in let b := Prim.snd x in a = a /\ b = b) *) - (** Understandably different, maybe, but should still be unfolded *) - Set Printing All. - Show. (* and - (forall x : NonPrim.prod Set Set, - match x return Prop with - | NonPrim.pair a b => and (@eq Set a a) (@eq Set b b) - end) - (forall x : Prim.prod Set Set, - let a := @Prim.fst Set Set x in - let b := @Prim.snd Set Set x in and (@eq Set a a) (@eq Set b b)) *) - Unset Printing All. -Abort. -Goal (forall x : NonPrim.prod Set Set, match x with NonPrim.pair a b => a = a /\ b = b end) -/\ (forall x : Prim.prod Set Set, match x with Prim.pair a b => a = a /\ b = b end). - Show. (* (forall x : NonPrim.prod Set Set, - match x with - | {| NonPrim.fst := a; NonPrim.snd := b |} => a = a /\ b = b - end) /\ - (forall x : Prim.prod Set Set, - Prim.fst x = Prim.fst x /\ Prim.snd x = Prim.snd x) *) - Set Printing All. - Show. - - set(foo:=forall x : Prim.prod Set Set, match x return Set with - | Prim.pair fst _ => fst - end). - (* and - (forall x : NonPrim.prod Set Set, - match x return Prop with - | NonPrim.pair a b => and (@eq Set a a) (@eq Set b b) - end) - (forall x : Prim.prod Set Set, - and (@eq Set (@Prim.fst Set Set x) (@Prim.fst Set Set x)) - (@eq Set (@Prim.snd Set Set x) (@Prim.snd Set Set x))) *) - Unset Printing All. -Abort. diff --git a/test-suite/bugs/closed/3703.v b/test-suite/bugs/closed/3703.v deleted file mode 100644 index feeb04d64e..0000000000 --- a/test-suite/bugs/closed/3703.v +++ /dev/null @@ -1,32 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 6746 lines to 4190 lines, then from 29 lines to 18 lines, then fro\ -m 30 lines to 19 lines *) -(* coqc version trunk (October 2014) compiled on Oct 7 2014 12:42:41 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (2313bde0116a5916912bebbaca77d291f7b2760a) *) -Record PreCategory := { identity : forall x, x -> x }. -Definition set_cat : PreCategory := @Build_PreCategory (fun T x => x). -Module UnKeyed. - Global Unset Keyed Unification. - Goal forall (T : Type) (g0 g1 : T) (k : T) (H' : forall x : T, k = @identity set_cat T x), - ((fun x : T => x) g0) = ((fun x : T => x) g1). - intros T g0 g1 k H'. - change (identity _ _) with (fun y : T => y) in H'; - rewrite <- H' || fail "too early". - Undo. - rewrite <- H'. - admit. - Defined. -End UnKeyed. -Module Keyed. - Global Set Keyed Unification. - Declare Equivalent Keys (fun x => _) identity. - Goal forall (T : Type) (g0 g1 : T) (k : T) (H' : forall x : T, k = @identity set_cat T x), - ((fun x : T => x) g0) = ((fun x : T => x) g1). - intros T g0 g1 k H'. - change (identity _ _) with (fun y : T => y) in H'; - rewrite <- H' || fail "too early". - Undo. - rewrite <- H'. - admit. - Defined. -End Keyed. diff --git a/test-suite/bugs/closed/3709.v b/test-suite/bugs/closed/3709.v deleted file mode 100644 index 815f5b9507..0000000000 --- a/test-suite/bugs/closed/3709.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Import TestSuite.admit. -Module NonPrim. - Unset Primitive Projections. - Record hProp := hp { hproptype :> Type }. - Goal forall (h : (Type -> hProp) -> (Type -> hProp)) k f, - (forall y, h y = y) -> - h (fun b : Type => {| hproptype := f b |}) = k. - Proof. - intros h k f H. - etransitivity. - apply H. - admit. - Defined. -End NonPrim. -Module Prim. - Set Primitive Projections. - Record hProp := hp { hproptype :> Type }. - Goal forall (h : (Type -> hProp) -> (Type -> hProp)) k f, - (forall y, h y = y) -> - h (fun b : Type => {| hproptype := f b |}) = k. - Proof. - intros h k f H. - etransitivity. - apply H. diff --git a/test-suite/bugs/closed/3710.v b/test-suite/bugs/closed/3710.v deleted file mode 100644 index b9e2798d88..0000000000 --- a/test-suite/bugs/closed/3710.v +++ /dev/null @@ -1,48 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 13477 lines to 1457 lines, then from 1553 lines to 1586 lines, then \ -from 1574 lines to 823 lines, then from 837 lines to 802 lines, then from 793 lines to 657 lines, then from 661 lines to 233 lines, t\ -hen from 142 lines to 65 lines *) -(* coqc version trunk (October 2014) compiled on Oct 8 2014 13:38:17 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (335cf2860bfd9e714d14228d75a52fd2c88db386) *) -Set Universe Polymorphism. -Set Primitive Projections. -Set Implicit Arguments. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. -Definition relation (A : Type) := A -> A -> Type. -Class Reflexive {A} (R : relation A) := reflexivity : forall x : A, R x x. -Notation "( x ; y )" := (existT _ x y). -Notation "x .1" := (projT1 x) (at level 3, format "x '.1'"). -Reserved Infix "o" (at level 40, left associativity). -Delimit Scope category_scope with category. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - compose : forall s d d', morphism d d' -> morphism s d -> morphism s d' }. -Delimit Scope functor_scope with functor. -Record Functor (C D : PreCategory) := { object_of :> C -> D }. -Local Open Scope category_scope. -Class Isomorphic {C : PreCategory} (s d : C) := {}. -Axiom composeF : forall C D E (G : Functor D E) (F : Functor C D), Functor C E. -Infix "o" := composeF : functor_scope. -Local Open Scope functor_scope. -Definition sub_pre_cat {P : PreCategory -> Type} : PreCategory. - exact (@Build_PreCategory - { C : PreCategory & P C } - (fun C D => Functor C.1 D.1) - (fun _ _ _ F G => F o G)). -Defined. -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. -Axiom composeT : forall C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F'), - NaturalTransformation F F''. -Definition functor_category (C D : PreCategory) : PreCategory. - exact (@Build_PreCategory (Functor C D) - (@NaturalTransformation C D) - (@composeT C D)). -Defined. -Local Notation "C -> D" := (functor_category C D) : category_scope. -Definition NaturalIsomorphism (C D : PreCategory) F G : Type := @Isomorphic (C -> D) F G. -Context `{P : PreCategory -> Type}. -Local Notation cat := (@sub_pre_cat P). -Goal forall (s d d' : cat) (m1 : morphism cat d d') (m2 : morphism cat s d), - NaturalIsomorphism (m1 o m2) (m1 o m2)%functor. -Fail exact (fun _ _ _ _ _ => reflexivity _). diff --git a/test-suite/bugs/closed/3723.v b/test-suite/bugs/closed/3723.v deleted file mode 100644 index d0b77c451b..0000000000 --- a/test-suite/bugs/closed/3723.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Bugs #3787 and #3723 on reinitializing camlp5 levels *) - -Definition a := True. -Reserved Notation "-- x" (at level 50, x at level 20). -Reserved Notation "--- x" (at level 20). -Reset a. diff --git a/test-suite/bugs/closed/3732.v b/test-suite/bugs/closed/3732.v deleted file mode 100644 index 13d62b8ff6..0000000000 --- a/test-suite/bugs/closed/3732.v +++ /dev/null @@ -1,105 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 2073 lines to 358 lines, then from 359 lines to 218 lines, then from 107 lines to 92 lines *) -(* coqc version trunk (October 2014) compiled on Oct 11 2014 1:13:41 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d65496f09c4b68fa318783e53f9cd6d5c18e1eb7) *) -Require Coq.Lists.List. - -Import Coq.Lists.List. - -Set Implicit Arguments. -Global Set Asymmetric Patterns. - -Section machine. - Variables pc state : Type. - - Inductive propX (i := pc) (j := state) : list Type -> Type := - | Inj : forall G, Prop -> propX G - | ExistsX : forall G A, propX (A :: G) -> propX G. - - Arguments Inj [G]. - - Definition PropX := propX nil. - Fixpoint last (G : list Type) : Type. - exact (match G with - | nil => unit - | T :: nil => T - | _ :: G' => last G' - end). - Defined. - Fixpoint eatLast (G : list Type) : list Type. - exact (match G with - | nil => nil - | _ :: nil => nil - | x :: G' => x :: eatLast G' - end). - Defined. - - Fixpoint subst G (p : propX G) : (last G -> PropX) -> propX (eatLast G) := - match p with - | Inj _ P => fun _ => Inj P - | ExistsX G A p1 => fun p' => - match G return propX (A :: G) -> propX (eatLast (A :: G)) -> propX (eatLast G) with - | nil => fun p1 _ => ExistsX p1 - | _ :: _ => fun _ rc => ExistsX rc - end p1 (subst p1 (match G return (last G -> PropX) -> last (A :: G) -> PropX with - | nil => fun _ _ => Inj True - | _ => fun p' => p' - end p')) - end. - - Definition spec := state -> PropX. - Definition codeSpec := pc -> option spec. - - Inductive valid (specs : codeSpec) (G : list PropX) : PropX -> Prop := Env : forall P, In P G -> valid specs G P. - Definition interp specs := valid specs nil. -End machine. -Notation "'ExX' : A , P" := (ExistsX (A := A) P) (at level 89) : PropX_scope. -Bind Scope PropX_scope with PropX propX. -Variables pc state : Type. - -Inductive subs : list Type -> Type := -| SNil : subs nil -| SCons : forall T Ts, (last (T :: Ts) -> PropX pc state) -> subs (eatLast (T :: Ts)) -> subs (T :: Ts). - -Fixpoint SPush G T (s : subs G) (f : T -> PropX pc state) : subs (T :: G) := - match s in subs G return subs (T :: G) with - | SNil => SCons _ nil f SNil - | SCons T' Ts f' s' => SCons T (T' :: Ts) f' (SPush s' f) - end. - -Fixpoint Substs G (s : subs G) : propX pc state G -> PropX pc state := - match s in subs G return propX pc state G -> PropX pc state with - | SNil => fun p => p - | SCons _ _ f s' => fun p => Substs s' (subst p f) - end. -Variable specs : codeSpec pc state. - -Lemma simplify_fwd_ExistsX : forall G A s (p : propX pc state (A :: G)), - interp specs (Substs s (ExX : A, p)) - -> exists a, interp specs (Substs (SPush s a) p). -admit. -Defined. - -Goal forall (G : list Type) (A : Type) (p : propX pc state (@cons Type A G)) - (s : subs G) - (_ : @interp pc state specs (@Substs G s (@ExistsX pc state G A p))) - (P : forall _ : subs (@cons Type A G), Prop) - (_ : forall (s0 : subs (@cons Type A G)) - (_ : @interp pc state specs (@Substs (@cons Type A G) s0 p)), - P s0), - @ex (forall _ : A, PropX pc state) - (fun a : forall _ : A, PropX pc state => P (@SPush G A s a)). - intros ? ? ? ? H ? H'. - apply simplify_fwd_ExistsX in H. - firstorder. -Qed. - (* Toplevel input, characters 15-19: -Error: Illegal application: -The term "cons" of type "forall A : Type, A -> list A -> list A" -cannot be applied to the terms - "Type" : "Type" - "T" : "Type" - "G0" : "list Type" -The 2nd term has type "Type@{Top.53}" which should be coercible to - "Type@{Top.12}". - *) diff --git a/test-suite/bugs/closed/3735.v b/test-suite/bugs/closed/3735.v deleted file mode 100644 index aced9615ee..0000000000 --- a/test-suite/bugs/closed/3735.v +++ /dev/null @@ -1,4 +0,0 @@ -Require Import Coq.Program.Tactics. -Class Foo := { bar : Type }. -Fail Lemma foo : Foo -> bar. (* 'Command has indeed failed.' in both 8.4 and trunk *) -Fail Program Lemma foo : Foo -> bar. diff --git a/test-suite/bugs/closed/3736.v b/test-suite/bugs/closed/3736.v deleted file mode 100644 index 637b77cc58..0000000000 --- a/test-suite/bugs/closed/3736.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Check non-error failure in case of unsupported decidability scheme *) -Local Set Decidable Equality Schemes. - -Inductive a := A with b := B. - -(* But fails with error if explicitly asked for the scheme *) - -Fail Scheme Equality for a. diff --git a/test-suite/bugs/closed/3743.v b/test-suite/bugs/closed/3743.v deleted file mode 100644 index ca78987bf3..0000000000 --- a/test-suite/bugs/closed/3743.v +++ /dev/null @@ -1,11 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 967 lines to 469 lines, then from 459 lines to 35 lines *) -(* coqc version trunk (October 2014) compiled on Oct 11 2014 1:13:41 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d65496f09c4b68fa318783e53f9cd6d5c18e1eb7) *) -Require Export Coq.Setoids.Setoid. - -Add Parametric Relation A -: A (@eq A) - transitivity proved by transitivity - as refine_rel. -(* Toplevel input, characters 20-118: -Anomaly: index to an anonymous variable. Please report. *) diff --git a/test-suite/bugs/closed/3746.v b/test-suite/bugs/closed/3746.v deleted file mode 100644 index a9463f94bb..0000000000 --- a/test-suite/bugs/closed/3746.v +++ /dev/null @@ -1,92 +0,0 @@ - -(* Bug report #3746 : Include and restricted signature *) - -Module Type MT. Parameter p : nat. End MT. -Module Type EMPTY. End EMPTY. -Module Empty. End Empty. - -(* Include of an applied functor with restricted sig : - Used to create axioms (bug report #3746), now forbidden. *) - -Module F (X:EMPTY) : MT. - Definition p := 0. -End F. - -Module InclFunctRestr. - Fail Include F(Empty). -End InclFunctRestr. - -(* A few variants (indirect restricted signature), also forbidden. *) - -Module F1 := F. -Module F2 (X:EMPTY) := F X. - -Module F3a (X:EMPTY). Definition p := 0. End F3a. -Module F3 (X:EMPTY) : MT := F3a X. - -Module InclFunctRestrBis. - Fail Include F1(Empty). - Fail Include F2(Empty). - Fail Include F3(Empty). -End InclFunctRestrBis. - -(* Recommended workaround: manual instance before the include. *) - -Module InclWorkaround. - Module Temp := F(Empty). - Include Temp. -End InclWorkaround. - -Compute InclWorkaround.p. -Print InclWorkaround.p. -Print Assumptions InclWorkaround.p. (* Closed under the global context *) - - - -(* Related situations which are ok, just to check *) - -(* A) Include of non-functor with restricted signature : - creates a proxy to initial stuff *) - -Module M : MT. - Definition p := 0. -End M. - -Module InclNonFunct. - Include M. -End InclNonFunct. - -Definition check : InclNonFunct.p = M.p := eq_refl. -Print Assumptions InclNonFunct.p. (* Closed *) - - -(* B) Include of a module type with opaque content: - The opaque content is "copy-pasted". *) - -Module Type SigOpaque. - Definition p : nat. Proof. exact 0. Qed. -End SigOpaque. - -Module InclSigOpaque. - Include SigOpaque. -End InclSigOpaque. - -Compute InclSigOpaque.p. -Print InclSigOpaque.p. -Print Assumptions InclSigOpaque.p. (* Closed *) - - -(* C) Include of an applied functor with opaque proofs : - opaque proof "copy-pasted" (and substituted). *) - -Module F' (X:EMPTY). - Definition p : nat. Proof. exact 0. Qed. -End F'. - -Module InclFunctOpa. - Include F'(Empty). -End InclFunctOpa. - -Compute InclFunctOpa.p. -Print InclFunctOpa.p. -Print Assumptions InclFunctOpa.p. (* Closed *) diff --git a/test-suite/bugs/closed/3753.v b/test-suite/bugs/closed/3753.v deleted file mode 100644 index f586438cdd..0000000000 --- a/test-suite/bugs/closed/3753.v +++ /dev/null @@ -1,4 +0,0 @@ -Axiom foo : Type -> Type. -Axiom bar : forall (T : Type), T -> foo T. -Arguments bar A x : rename. -About bar. diff --git a/test-suite/bugs/closed/3755.v b/test-suite/bugs/closed/3755.v deleted file mode 100644 index 77427ace58..0000000000 --- a/test-suite/bugs/closed/3755.v +++ /dev/null @@ -1,16 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 6729 lines to -411 lines, then from 148 lines to 115 lines, then from 99 lines to 70 lines, -then from 85 lines to 63 lines, then from 76 lines to 55 lines, then from 61 -lines to 17 lines *) -(* coqc version trunk (January 2015) compiled on Jan 17 2015 21:58:5 with OCaml -4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk -(9e6b28c04ad98369a012faf3bd4d630cf123a473) *) -Set Printing Universes. -Section param. - Variable typeD : Set -> Set. - Variable STex : forall (T : Type) (p : T -> Set), Set. - Definition existsEach_cons' v (P : @sigT _ typeD -> Set) := - @STex _ (fun x => P (@existT _ _ v x)). - - Check @existT _ _ STex STex. diff --git a/test-suite/bugs/closed/3777.v b/test-suite/bugs/closed/3777.v deleted file mode 100644 index e203528fcc..0000000000 --- a/test-suite/bugs/closed/3777.v +++ /dev/null @@ -1,17 +0,0 @@ -Unset Strict Universe Declaration. -Module WithoutPoly. - Unset Universe Polymorphism. - Definition foo (A : Type@{i}) (B : Type@{i}) := A -> B. - Set Printing Universes. - Definition bla := ((@foo : Set -> _ -> _) : _ -> Type -> _). - (* ((fun A : Set => foo A):Set -> Type@{Top.55} -> Type@{Top.55}) -:Set -> Type@{Top.55} -> Type@{Top.55} - : Set -> Type@{Top.55} -> Type@{Top.55} -(* |= Set <= Top.55 - *) *) -End WithoutPoly. -Module WithPoly. - Set Universe Polymorphism. - Definition foo (A : Type@{i}) (B : Type@{i}) := A -> B. - Set Printing Universes. - Fail Check ((@foo : Set -> _ -> _) : _ -> Type -> _). diff --git a/test-suite/bugs/closed/3779.v b/test-suite/bugs/closed/3779.v deleted file mode 100644 index 2b44e225e8..0000000000 --- a/test-suite/bugs/closed/3779.v +++ /dev/null @@ -1,12 +0,0 @@ -Unset Strict Universe Declaration. -Set Universe Polymorphism. -Record UnitSubuniverse := { a : Type@{sm} ; x : (Type@{sm} : Type@{lg}) ; inO_internal : Type@{lg} -> Type@{lg} }. -Class In (O : UnitSubuniverse@{sm lg}) (T : Type@{lg}) := in_inO_internal : inO_internal O T. -Section foo. - Universes sm lg. - Context (O : UnitSubuniverse@{sm lg}). - Context {A : Type@{sm}}. - Context (H' : forall (C : Type@{lg}) `{In@{sm lg} O C} (f : A -> C), In@{sm lg} O C). - Fail Check (H' : forall (C : Type@{lg}) `{In@{i j} O C} (f : A -> C), In@{j i} O C). - Fail Context (H'' : forall (C : Type@{lg}) `{In@{i j} O C} (f : A -> C), In@{j i} O C). -End foo. diff --git a/test-suite/bugs/closed/3782.v b/test-suite/bugs/closed/3782.v deleted file mode 100644 index 16b0b8b603..0000000000 --- a/test-suite/bugs/closed/3782.v +++ /dev/null @@ -1,64 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 2674 lines to 136 lines, then from 115 lines to 61 lines *) -(* coqc version trunk (October 2014) compiled on Oct 28 2014 14:33:38 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,(no branch) (53bfe9cf58a3c40e6eb7120d25c1633a9cea3126) *) -Class IsEquiv {A B : Type} (f : A -> B) := {}. -Record Equiv A B := { equiv_fun : A -> B ; equiv_isequiv : IsEquiv equiv_fun }. -Arguments equiv_fun {A B} _ _. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Set Printing Coercions. -Set Printing Implicit. -Module NonPrim. - Unset Primitive Projections. - Record TruncType (n : nat) := { trunctype_type :> Type }. - Canonical Structure default_TruncType := fun n T => (@Build_TruncType n T). - Goal (forall (s d : TruncType 0) (m : trunctype_type 0 s -> trunctype_type 0 d), - @IsEquiv (trunctype_type 0 s) (trunctype_type 0 d) m -> Type) -> - forall (T T0 : Type) (m : T0 -> T), @IsEquiv T0 T m -> True. - intros isiso_isequiv' mc md e e'. - (pose (@isiso_isequiv' - _ _ - (e - : (Build_TruncType 0 md) -> - (Build_TruncType 0 mc)) - e') as i || fail "too early"); clear i. - pose (@isiso_isequiv' - _ _ _ - e'). - admit. - Defined. -End NonPrim. -Module Prim. - Set Primitive Projections. - Record TruncType (n : nat) := { trunctype_type :> Type }. - Canonical Structure default_TruncType := fun n T => (@Build_TruncType n T). - Goal (forall (s d : TruncType 0) (m : trunctype_type 0 s -> trunctype_type 0 d), - @IsEquiv (trunctype_type 0 s) (trunctype_type 0 d) m -> Type) -> - forall (T T0 : Type) (m : T0 -> T), @IsEquiv T0 T m -> True. - intros isiso_isequiv' mc md e e'. - (pose (@isiso_isequiv' - _ _ - (e - : (Build_TruncType 0 md) -> - (Build_TruncType 0 mc)) - e') as i || fail "too early"); clear i. - Set Printing Existential Instances. - Set Debug Unification. - pose (@isiso_isequiv' - _ _ _ - e'). (* Toplevel input, characters 48-50: -Error: -In environment -isiso_isequiv' : forall (s d : TruncType 0) - (m : trunctype_type 0 s -> trunctype_type 0 d), - @IsEquiv (trunctype_type 0 s) (trunctype_type 0 d) m -> Type -mc : Type -md : Type -e : md -> mc -e' : @IsEquiv md mc e -The term "e'" has type "@IsEquiv md mc e" while it is expected to have type - "@IsEquiv (trunctype_type 0 ?t) (trunctype_type 0 ?t0) ?t1". - *) - admit. - Defined. -End Prim. diff --git a/test-suite/bugs/closed/3783.v b/test-suite/bugs/closed/3783.v deleted file mode 100644 index f7e2b54353..0000000000 --- a/test-suite/bugs/closed/3783.v +++ /dev/null @@ -1,33 +0,0 @@ -Require Import TestSuite.admit. -Fixpoint exp (n : nat) (T : Set) - := match n with - | 0 => T - | S n' => exp n' (T * T) - end. -Definition big := Eval compute in exp 13 nat. -Module NonPrim. - Unset Primitive Projections. - Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. - Definition x : sigT (fun x => x). - Proof. - exists big; admit. - Defined. - Goal True. - pose ((fun y => y = y) (projT1 _ x)) as y. - Time cbv beta in y. (* 0s *) - admit. - Defined. -End NonPrim. -Module Prim. - Set Primitive Projections. - Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. - Definition x : sigT (fun x => x). - Proof. - exists big; admit. - Defined. - Goal True. - pose ((fun y => y = y) (projT1 _ x)) as y. - Timeout 1 cbv beta in y. (* takes around 2s. Grows with the value passed to [exp] above *) - admit. - Defined. -End Prim. diff --git a/test-suite/bugs/closed/3786.v b/test-suite/bugs/closed/3786.v deleted file mode 100644 index 23d19e946f..0000000000 --- a/test-suite/bugs/closed/3786.v +++ /dev/null @@ -1,33 +0,0 @@ -Require Import TestSuite.admit. -Require Coq.Lists.List. -Require Coq.Sets.Ensembles. -Import Coq.Sets.Ensembles. -Global Set Implicit Arguments. -Delimit Scope comp_scope with comp. -Inductive Comp : Type -> Type := -| Return : forall A, A -> Comp A -| Bind : forall A B, Comp A -> (A -> Comp B) -> Comp B -| Pick : forall A, Ensemble A -> Comp A. -Notation ret := Return. -Notation "x <- y ; z" := (Bind y%comp (fun x => z%comp)) - (at level 81, right associativity, - format "'[v' x <- y ; '/' z ']'") : comp_scope. -Axiom refine : forall {A} (old : Comp A) (new : Comp A), Prop. -Open Scope comp. -Axiom elements : forall {A} (ls : list A), Ensemble A. -Axiom to_list : forall {A} (S : Ensemble A), Comp (list A). -Axiom finite_set_handle_cardinal : refine (ret 0) (ret 0). -Definition sumUniqueSpec (ls : list nat) : Comp nat. - exact (ls' <- to_list (elements ls); - List.fold_right (fun a b' => Bind b' ((fun a b => ret (a + b)) a)) (ret 0) ls'). -Defined. -Axiom admit : forall {T}, T. -Definition sumUniqueImpl (ls : list nat) -: { c : _ | refine (sumUniqueSpec ls) (ret c) }%type. -Proof. - eexists. - match goal with - | [ |- refine ?a ?b ] => let a' := eval hnf in a in change (refine a' b) - end. - try setoid_rewrite (@finite_set_handle_cardinal). -Abort. diff --git a/test-suite/bugs/closed/3788.v b/test-suite/bugs/closed/3788.v deleted file mode 100644 index 2c5b9cb018..0000000000 --- a/test-suite/bugs/closed/3788.v +++ /dev/null @@ -1,6 +0,0 @@ -Set Implicit Arguments. -Global Set Primitive Projections. -Record Functor (C D : Type) := { object_of :> forall _ : C, D }. -Axiom path_functor_uncurried : forall C D (F G : Functor C D) (_ : sigT (fun HO : object_of F = object_of G => Set)), F = G. -Fail Lemma path_functor_uncurried_snd C D F G HO HM -: (@path_functor_uncurried C D F G (existT _ HO HM)) = HM. diff --git a/test-suite/bugs/closed/3792.v b/test-suite/bugs/closed/3792.v deleted file mode 100644 index 39057b9c52..0000000000 --- a/test-suite/bugs/closed/3792.v +++ /dev/null @@ -1,4 +0,0 @@ -Fail Definition pull_if_dep -: forall {A} (P : bool -> Type) (a : A true) (a' : A false) - (b : bool), - P (if b as b return A b then a else a'). diff --git a/test-suite/bugs/closed/3798.v b/test-suite/bugs/closed/3798.v deleted file mode 100644 index b9f0daa71c..0000000000 --- a/test-suite/bugs/closed/3798.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import TestSuite.admit. -Require Setoid. - -Parameter f : nat -> nat. -Axiom a : forall n, 0 < n -> f n = 0. -Hint Rewrite a using ( simpl; admit ). - -Goal f 1 = 0. -Proof. - rewrite_strat (topdown (hints core)). - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/3804.v b/test-suite/bugs/closed/3804.v deleted file mode 100644 index da9290cbad..0000000000 --- a/test-suite/bugs/closed/3804.v +++ /dev/null @@ -1,12 +0,0 @@ -Set Universe Polymorphism. -Module Foo. - Definition T : sigT (fun x => x). - Proof. - exists Set. - abstract exact nat. - Defined. -End Foo. -Module Bar. - Include Foo. -End Bar. -Definition foo := eq_refl : Foo.T = Bar.T. diff --git a/test-suite/bugs/closed/3807.v b/test-suite/bugs/closed/3807.v deleted file mode 100644 index a6286f0377..0000000000 --- a/test-suite/bugs/closed/3807.v +++ /dev/null @@ -1,33 +0,0 @@ -Set Universe Polymorphism. -Set Printing Universes. -Unset Universe Minimization ToSet. - - -Definition foo : Type := nat. -About foo. -(* foo@{Top.1} : Type@{Top.1}*) -(* Top.1 |= *) - -Definition bar : foo -> nat. -Admitted. -About bar. -(* bar@{Top.2} : foo@{Top.2} -> nat *) -(* Top.2 |= *) - -Lemma baz@{i} : foo@{i} -> nat. -Proof. - exact bar. -Defined. - -Definition bar'@{i} : foo@{i} -> nat. - intros f. exact 0. -Admitted. -About bar'. -(* bar'@{i} : foo@{i} -> nat *) -(* i |= *) - -Axiom f@{i} : Type@{i}. -(* -*** [ f@{i} : Type@{i} ] -(* i |= *) -*) diff --git a/test-suite/bugs/closed/3808.v b/test-suite/bugs/closed/3808.v deleted file mode 100644 index ac6a850193..0000000000 --- a/test-suite/bugs/closed/3808.v +++ /dev/null @@ -1,3 +0,0 @@ -Unset Strict Universe Declaration. -Inductive Foo : (let enforce := (fun x => x) : Type@{j} -> Type@{i} in Type@{i}) - := foo : Foo. diff --git a/test-suite/bugs/closed/3815.v b/test-suite/bugs/closed/3815.v deleted file mode 100644 index 5fb4839847..0000000000 --- a/test-suite/bugs/closed/3815.v +++ /dev/null @@ -1,9 +0,0 @@ -Require Import Setoid Coq.Program.Basics. -Global Open Scope program_scope. -Axiom foo : forall A (f : A -> A), f ∘ f = f. -Require Import Coq.Program.Combinators. -Hint Rewrite foo. -Theorem t {A B C D} (f : A -> A) (g : B -> C) (h : C -> D) -: f ∘ f = f. -Proof. - rewrite_strat topdown (hints core). diff --git a/test-suite/bugs/closed/3819.v b/test-suite/bugs/closed/3819.v deleted file mode 100644 index 0b9c3183cc..0000000000 --- a/test-suite/bugs/closed/3819.v +++ /dev/null @@ -1,9 +0,0 @@ -Record Op := { t : Type ; op : t -> t }. - -Canonical Structure OpType : Op := Build_Op Type (fun X => X). - -Lemma test1 (X:Type) : eq (op OpType X) X. -Proof eq_refl. - -Definition test2 (A:Type) : eq (op _ A) A. -Proof eq_refl. diff --git a/test-suite/bugs/closed/3821.v b/test-suite/bugs/closed/3821.v deleted file mode 100644 index 30261ed266..0000000000 --- a/test-suite/bugs/closed/3821.v +++ /dev/null @@ -1,3 +0,0 @@ -Unset Strict Universe Declaration. -Inductive quotient {A : Type@{i}} {B : Type@{j}} : Type@{max(i, j)} := . - diff --git a/test-suite/bugs/closed/3825.v b/test-suite/bugs/closed/3825.v deleted file mode 100644 index 666c64631f..0000000000 --- a/test-suite/bugs/closed/3825.v +++ /dev/null @@ -1,24 +0,0 @@ -Set Universe Polymorphism. -Set Printing Universes. - -Axiom foo@{i j} : Type@{i} -> Type@{j}. - -Notation bar := foo. - -Monomorphic Universes i j. - -Check bar@{i j}. -Fail Check bar@{i}. - -Notation qux := (nat -> nat). - -Fail Check qux@{i}. - -Axiom TruncType@{i} : nat -> Type@{i}. - -Notation "n -Type" := (TruncType n) (at level 1) : type_scope. -Notation hProp := (0)-Type. - -Check hProp. -Check hProp@{i}. - diff --git a/test-suite/bugs/closed/3828.v b/test-suite/bugs/closed/3828.v deleted file mode 100644 index ae11c6c96c..0000000000 --- a/test-suite/bugs/closed/3828.v +++ /dev/null @@ -1,2 +0,0 @@ -Goal 0 = 0. -Fail pose ?Goal. diff --git a/test-suite/bugs/closed/3848.v b/test-suite/bugs/closed/3848.v deleted file mode 100644 index c0ef02f1e8..0000000000 --- a/test-suite/bugs/closed/3848.v +++ /dev/null @@ -1,22 +0,0 @@ -Require Import TestSuite.admit. -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B} (f : A -> B) := { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. -Arguments eisretr {A B} f {_} _. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'"). -Generalizable Variables A B f g e n. -Definition functor_forall `{P : A -> Type} `{Q : B -> Type} - (f0 : B -> A) (f1 : forall b:B, P (f0 b) -> Q b) -: (forall a:A, P a) -> (forall b:B, Q b). - admit. -Defined. - -Lemma isequiv_functor_forall `{P : A -> Type} `{Q : B -> Type} - `{IsEquiv B A f} `{forall b, @IsEquiv (P (f b)) (Q b) (g b)} -: (forall b : B, Q b) -> forall a : A, P a. -Proof. - refine (functor_forall - (f^-1) - (fun (x:A) (y:Q (f^-1 x)) => eisretr f x # (g (f^-1 x))^-1 y)). -Defined. (* was: Error: Attempt to save an incomplete proof *) diff --git a/test-suite/bugs/closed/3849.v b/test-suite/bugs/closed/3849.v deleted file mode 100644 index a8dc3af9cf..0000000000 --- a/test-suite/bugs/closed/3849.v +++ /dev/null @@ -1,8 +0,0 @@ -Tactic Notation "foo" hyp_list(hs) := clear hs. - -Tactic Notation "bar" hyp_list(hs) := foo hs. - -Goal True. -do 5 pose proof 0 as ?n0. -foo n1 n2. -bar n3 n4. diff --git a/test-suite/bugs/closed/3854.v b/test-suite/bugs/closed/3854.v deleted file mode 100644 index 7e915f202b..0000000000 --- a/test-suite/bugs/closed/3854.v +++ /dev/null @@ -1,22 +0,0 @@ -Require Import TestSuite.admit. -Definition relation (A : Type) := A -> A -> Type. -Class Reflexive {A} (R : relation A) := reflexivity : forall x : A, R x x. -Axiom IsHProp : Type -> Type. -Existing Class IsHProp. -Inductive Empty : Set := . -Notation "~ x" := (x -> Empty) : type_scope. -Record hProp := BuildhProp { type :> Type ; trunc : IsHProp type }. -Arguments BuildhProp _ {_}. -Canonical Structure default_hProp := fun T P => (@BuildhProp T P). -Generalizable Variables A B f g e n. -Axiom trunc_forall : forall `{P : A -> Type}, IsHProp (forall a, P a). -Existing Instance trunc_forall. -Inductive V : Type := | set {A : Type} (f : A -> V) : V. -Axiom mem : V -> V -> hProp. -Axiom mem_induction -: forall (C : V -> hProp), (forall v, (forall x, mem x v -> C x) -> C v) -> forall v, C v. -Definition irreflexive_mem : forall x, (fun x y => ~ mem x y) x x. -Proof. - pose (fun x => BuildhProp (~ mem x x)). - refine (mem_induction (fun x => BuildhProp (~ mem x x)) _); simpl in *. - admit. diff --git a/test-suite/bugs/closed/3881.v b/test-suite/bugs/closed/3881.v deleted file mode 100644 index 7c60ddf347..0000000000 --- a/test-suite/bugs/closed/3881.v +++ /dev/null @@ -1,35 +0,0 @@ -(* -*- coq-prog-args: ("-nois" "-R" "../theories" "Coq") -*- *) -(* File reduced by coq-bug-finder from original input, then from 2236 lines to 1877 lines, then from 1652 lines to 160 lines, then from 102 lines to 34 lines *) -(* coqc version trunk (December 2014) compiled on Dec 23 2014 22:6:43 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (90ed6636dea41486ddf2cc0daead83f9f0788163) *) -Generalizable All Variables. -Require Import Coq.Init.Notations. -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Axiom admit : forall {T}, T. -Notation "g 'o' f" := (fun x => g (f x)) (at level 40, left associativity). -Notation "g 'o' f" := ltac:(let g' := g in let f' := f in exact (fun x => g' (f' x))) (at level 40, left associativity). (* Ensure that x is not captured in [g] or [f] in case they contain holes *) -Inductive eq {A} (x:A) : A -> Prop := eq_refl : x = x where "x = y" := (@eq _ x y) : type_scope. -Arguments eq_refl {_ _}. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with eq_refl => eq_refl end. -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : forall x, f (equiv_inv x) = x }. -Arguments eisretr {A B} f {_} _. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'"). -Global Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} : IsEquiv (g o f) | 1000 := admit. -Definition isequiv_homotopic {A B} (f : A -> B) (g : A -> B) `{IsEquiv A B f} (h : forall x, f x = g x) : IsEquiv g := admit. -Global Instance isequiv_inverse {A B} (f : A -> B) {feq : IsEquiv f} : IsEquiv f^-1 | 10000 := admit. -Definition cancelR_isequiv {A B C} (f : A -> B) {g : B -> C} `{IsEquiv A B f} `{IsEquiv A C (g o f)} : IsEquiv g. -Proof. - pose (fun H => @isequiv_homotopic _ _ ((g o f) o f^-1) _ H - (fun b => ap g (eisretr f b))) as k. - revert k. - let x := match goal with |- let k := ?x in _ => constr:(x) end in - intro k; clear k; - pose (x _). - pose (@isequiv_homotopic _ _ ((g o f) o f^-1) g _ - (fun b => ap g (eisretr f b))). - Undo. - apply (@isequiv_homotopic _ _ ((g o f) o f^-1) g _ - (fun b => ap g (eisretr f b))). -Qed. - diff --git a/test-suite/bugs/closed/3886.v b/test-suite/bugs/closed/3886.v deleted file mode 100644 index b523b117e5..0000000000 --- a/test-suite/bugs/closed/3886.v +++ /dev/null @@ -1,23 +0,0 @@ -Require Import Program. - -Inductive Even : nat -> Prop := -| evenO : Even O -| evenS : forall n, Odd n -> Even (S n) -with Odd : nat -> Prop := -| oddS : forall n, Even n -> Odd (S n). - -Program Fixpoint doubleE {n} (e : Even n) : Even (2 * n) - := _ -with doubleO {n} (o : Odd n) : Odd (S (2 * n)) - := _. -Obligations. -Axiom cheat : forall {A}, A. -Obligation 1 of doubleE. -apply cheat. -Qed. - -Obligation 1 of doubleO. -apply cheat. -Qed. - -Check doubleE. diff --git a/test-suite/bugs/closed/3892.v b/test-suite/bugs/closed/3892.v deleted file mode 100644 index 833722ba9a..0000000000 --- a/test-suite/bugs/closed/3892.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Check that notation variables do not capture names hidden behind - another notation. *) -Notation "A <-> B" := ((A -> B) * (B -> A))%type : type_scope. -Notation compose := (fun g f x => g (f x)). -Notation "g 'o' f" := (compose g f) (at level 40, left associativity). -Definition iff_compose {A B C : Type} (g : B <-> C) (f : A <-> B) : A <-> C := - (fst g o fst f , snd f o snd g). -(* Used to fail with: This expression should be a name. *) diff --git a/test-suite/bugs/closed/3895.v b/test-suite/bugs/closed/3895.v deleted file mode 100644 index 8659ca2cbd..0000000000 --- a/test-suite/bugs/closed/3895.v +++ /dev/null @@ -1,22 +0,0 @@ -Notation pr1 := (@projT1 _ _). -Notation compose := (fun g' f' x => g' (f' x)). -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : -function_scope. -Open Scope function_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p -with eq_refl => eq_refl end. -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) := forall x:A, -f x = g x. -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : -type_scope. -Theorem Univalence_implies_FunextNondep (A B : Type) -: forall f g : A -> B, f == g -> f = g. -Proof. - intros f g p. - pose (d := fun x : A => existT (fun xy => fst xy = snd xy) (f x, f x) -(eq_refl (f x))). - pose (e := fun x : A => existT (fun xy => fst xy = snd xy) (f x, g x) (p x)). - change f with ((snd o pr1) o d). - change g with ((snd o pr1) o e). - apply (ap (fun g => snd o pr1 o g)). -(* Used to raise a not Found due to a "typo" in solve_evar_evar *) diff --git a/test-suite/bugs/closed/3896.v b/test-suite/bugs/closed/3896.v deleted file mode 100644 index b433922a21..0000000000 --- a/test-suite/bugs/closed/3896.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal True. -pose proof 0 as n. -Fail apply pair in n. -(* Used to be an anomaly for a while *) diff --git a/test-suite/bugs/closed/3899.v b/test-suite/bugs/closed/3899.v deleted file mode 100644 index 7754934c0b..0000000000 --- a/test-suite/bugs/closed/3899.v +++ /dev/null @@ -1,11 +0,0 @@ -Set Primitive Projections. -Record unit : Set := tt {}. -Fail Check fun x : unit => eq_refl : tt = x. -Fail Check fun x : unit => eq_refl : x = tt. -Fail Check fun x y : unit => (eq_refl : x = tt) : x = y. -Fail Check fun x y : unit => eq_refl : x = y. - -Record ok : Set := tt' { a : unit }. - -Record nonprim : Prop := { undef : unit }. -Record prim : Prop := { def : True }. diff --git a/test-suite/bugs/closed/3900.v b/test-suite/bugs/closed/3900.v deleted file mode 100644 index 6be2161c2f..0000000000 --- a/test-suite/bugs/closed/3900.v +++ /dev/null @@ -1,13 +0,0 @@ -Global Set Primitive Projections. -Set Implicit Arguments. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Variable A : PreCategory. -Variable Pobj : A -> Type. -Local Notation obj := (sigT Pobj). -Variable Pmor : forall s d : obj, morphism A (projT1 s) (projT1 d) -> Type. -Class Foo (x : Type) := { _ : forall y, y }. -Local Instance ishset_pmor {s d m} : Foo (Pmor s d m). -Proof. -SearchAbout ((forall _ _, _) -> Foo _). -Abort. diff --git a/test-suite/bugs/closed/3911.v b/test-suite/bugs/closed/3911.v deleted file mode 100644 index b289eafbf4..0000000000 --- a/test-suite/bugs/closed/3911.v +++ /dev/null @@ -1,26 +0,0 @@ -(* Tested against coq ee596bc *) - -Set Nonrecursive Elimination Schemes. -Set Primitive Projections. -Set Universe Polymorphism. - -Record setoid := { base : Type }. - -Definition catdata (Obj Arr : Type) : Type := nat. - (* [nat] can be replaced by any other type, it seems, - without changing the error *) - -Record cat : Type := - { - obj : setoid; - arr : Type; - dta : catdata (base obj) arr - }. - -Definition bcwa (C:cat) (B:setoid) :Type := nat. - (* As above, nothing special about [nat] here. *) - -Record temp {C}{B} (e:bcwa C B) := - { fld : base (obj C) }. - -Print temp_rect. diff --git a/test-suite/bugs/closed/3916.v b/test-suite/bugs/closed/3916.v deleted file mode 100644 index 55c3a35c3a..0000000000 --- a/test-suite/bugs/closed/3916.v +++ /dev/null @@ -1,3 +0,0 @@ -Require Import List. -Fail Hint Resolve -> in_map. - diff --git a/test-suite/bugs/closed/3920.v b/test-suite/bugs/closed/3920.v deleted file mode 100644 index a4adb23cc2..0000000000 --- a/test-suite/bugs/closed/3920.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Setoid. -Axiom P : nat -> Prop. -Axiom P_or : forall x y, P (x + y) <-> P x \/ P y. -Lemma foo (H : P 3) : False. -eapply or_introl in H. -erewrite <- P_or in H. -(* Error: No such hypothesis: H *) diff --git a/test-suite/bugs/closed/3922.v b/test-suite/bugs/closed/3922.v deleted file mode 100644 index d88e8c3325..0000000000 --- a/test-suite/bugs/closed/3922.v +++ /dev/null @@ -1,85 +0,0 @@ -Unset Strict Universe Declaration. -Require Import TestSuite.admit. -Set Universe Polymorphism. -Notation Type0 := Set. - -Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. -Open Scope function_scope. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) -}. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. -Local Open Scope trunc_scope. -Notation "-2" := minus_two (at level 0) : trunc_scope. -Notation "-1" := (-2.+1) (at level 0) : trunc_scope. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | -2 => Contr_internal A - | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Notation Contr := (IsTrunc -2). -Notation IsHProp := (IsTrunc -1). - -Monomorphic Axiom dummy_funext_type : Type0. -Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. - -Inductive Unit : Set := - tt : Unit. - -Record TruncType (n : trunc_index) := BuildTruncType { - trunctype_type : Type ; - istrunc_trunctype_type : IsTrunc n trunctype_type -}. - -Arguments BuildTruncType _ _ {_}. - -Coercion trunctype_type : TruncType >-> Sortclass. - -Notation "n -Type" := (TruncType n) (at level 1) : type_scope. -Notation hProp := (-1)-Type. - -Notation BuildhProp := (BuildTruncType -1). - -Private Inductive Trunc (n : trunc_index) (A :Type) : Type := - tr : A -> Trunc n A. -Arguments tr {n A} a. - -Global Instance istrunc_truncation (n : trunc_index) (A : Type@{i}) -: IsTrunc@{j} n (Trunc@{i} n A). -Admitted. - -Definition Trunc_ind {n A} - (P : Trunc n A -> Type) {Pt : forall aa, IsTrunc n (P aa)} - : (forall a, P (tr a)) -> (forall aa, P aa) -:= (fun f aa => match aa with tr a => fun _ => f a end Pt). -Definition merely (A : Type@{i}) : hProp := BuildhProp (Trunc -1 A). -Definition cconst_factors_contr `{Funext} {X Y : Type} (f : X -> Y) - (P : Type) `{Pc : X -> Contr P} - (g : X -> P) (h : P -> Y) (p : h o g == f) -: Unit. -Proof. - assert (merely X -> IsHProp P) by admit. - refine (let g' := Trunc_ind (fun _ => P) g : merely X -> P in _); - [ assumption.. | ]. - pose (g'' := Trunc_ind (fun _ => P) g : merely X -> P). diff --git a/test-suite/bugs/closed/3923.v b/test-suite/bugs/closed/3923.v deleted file mode 100644 index 1d9488c6e1..0000000000 --- a/test-suite/bugs/closed/3923.v +++ /dev/null @@ -1,36 +0,0 @@ -Require Coq.extraction.Extraction. - -Module Type TRIVIAL. -Parameter t:Type. -End TRIVIAL. - -Module MkStore (Key : TRIVIAL). - -Module St : TRIVIAL. -Definition t := unit. -End St. - -End MkStore. - - - -Module Type CERTRUNTIMETYPES (B : TRIVIAL). - -Parameter cert_fieldstore : Type. -Parameter empty_fieldstore : cert_fieldstore. - -End CERTRUNTIMETYPES. - - - -Module MkCertRuntimeTypes (B : TRIVIAL) : CERTRUNTIMETYPES B. - -Module FieldStore := MkStore B. - -Definition cert_fieldstore := FieldStore.St.t. -Axiom empty_fieldstore : cert_fieldstore. - -End MkCertRuntimeTypes. - -Extraction MkCertRuntimeTypes. (* Was leading to an uncaught Not_found *) -Extraction TestCompile MkCertRuntimeTypes. diff --git a/test-suite/bugs/closed/3929.v b/test-suite/bugs/closed/3929.v deleted file mode 100644 index 955581ef26..0000000000 --- a/test-suite/bugs/closed/3929.v +++ /dev/null @@ -1,67 +0,0 @@ -Universes i j. -Set Printing Universes. -Set Printing All. -Polymorphic Definition lt@{x y} : Type@{y} := Type@{x}. -Goal True. -evar (T:Type@{i}). -set (Z := nat : Type@{j}). simpl in Z. -let Tv:=eval cbv [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -(** This enforces i <= j *) -Fail pose (lt@{i j}). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -exact I. -Defined. - -Goal True. -evar (T:nat). -pose (Z:=0). -let Tv:=eval cbv [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -Abort. - -Goal True. -evar (T:Set). -pose (Z:=nat). -let Tv:=eval cbv [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -Abort. - -Goal forall (A:Type)(a:A), True. -intros A a. -evar (T:A). -pose (Z:=a). -let Tv:=eval cbv delta [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -Abort. - -Goal True. -evar (T:Type). -pose (Z:=nat). -let Tv:=eval cbv [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -Abort. diff --git a/test-suite/bugs/closed/3938.v b/test-suite/bugs/closed/3938.v deleted file mode 100644 index 859e9f0177..0000000000 --- a/test-suite/bugs/closed/3938.v +++ /dev/null @@ -1,8 +0,0 @@ -Require Import TestSuite.admit. -Require Import Coq.Arith.PeanoNat. -Hint Extern 1 => admit : typeclass_instances. -Require Import Setoid. -Goal forall a b (f : nat -> Set) (R : nat -> nat -> Prop), - Equivalence R -> R a b -> f a = f b. - intros a b f H. - intros. Fail rewrite H1. diff --git a/test-suite/bugs/closed/3943.v b/test-suite/bugs/closed/3943.v deleted file mode 100644 index ac9c50369b..0000000000 --- a/test-suite/bugs/closed/3943.v +++ /dev/null @@ -1,50 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 9492 lines to 119 lines *) -(* coqc version 8.5beta1 (January 2015) compiled on Jan 18 2015 7:27:36 with OCaml 3.12.1 - coqtop version 8.5beta1 (January 2015) *) - -Set Typeclasses Dependency Order. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y" := (@paths _ x y) : type_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Set Implicit Arguments. -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. - -Record PreCategory := Build_PreCategory' { - object :> Type; - morphism : object -> object -> Type; - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' }. -Arguments identity {!C%category} / x%object : rename. -Arguments compose {!C%category} / {s d d'}%object (m1 m2)%morphism : rename. - -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { - morphism_inverse : morphism C d s; - left_inverse : compose morphism_inverse m = identity _; - right_inverse : compose m morphism_inverse = identity _ }. -Arguments morphism_inverse {C s d} m {_}. -Local Notation "m ^-1" := (morphism_inverse m) (at level 3, format "m '^-1'") : morphism_scope. - -Class Isomorphic {C : PreCategory} s d := { - morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. -Coercion morphism_isomorphic : Isomorphic >-> morphism. - -Variable C : PreCategory. -Variables s d : C. - -Definition path_isomorphic (i j : Isomorphic s d) -: @morphism_isomorphic _ _ _ i = @morphism_isomorphic _ _ _ j -> i = j. -Admitted. - -Definition ap_morphism_inverse_path_isomorphic (i j : Isomorphic s d) p q -: ap (fun e : Isomorphic s d => e^-1)%morphism (path_isomorphic i j p) = q. diff --git a/test-suite/bugs/closed/3944.v b/test-suite/bugs/closed/3944.v deleted file mode 100644 index 58e60f4f2e..0000000000 --- a/test-suite/bugs/closed/3944.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Import Setoid. -Definition C (T : Type) := T. -Goal forall T (i : C T) (v : T), True. -Proof. -Fail setoid_rewrite plus_n_Sm. diff --git a/test-suite/bugs/closed/3948.v b/test-suite/bugs/closed/3948.v deleted file mode 100644 index 56b1e3ffb4..0000000000 --- a/test-suite/bugs/closed/3948.v +++ /dev/null @@ -1,24 +0,0 @@ -Module Type S. -Parameter t : Type. -End S. - -Module Bar(X : S). -Definition elt := X.t. -Axiom fold : elt. -End Bar. - -Module Make (Z: S) := Bar(Z). - -Declare Module Y : S. - -Module Type Interface. -Parameter constant : unit. -End Interface. - -Module DepMap : Interface. -Module Dom := Make(Y). -Definition constant : unit := - let _ := @Dom.fold in tt. -End DepMap. - -Print Assumptions DepMap.constant. diff --git a/test-suite/bugs/closed/3953.v b/test-suite/bugs/closed/3953.v deleted file mode 100644 index 167cecea8e..0000000000 --- a/test-suite/bugs/closed/3953.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Checking subst on instances of evars (was bugged in 8.5 beta 1) *) -Goal forall (a b : unit), a = b -> exists c, b = c. - intros. - eexists. - subst. diff --git a/test-suite/bugs/closed/3956.v b/test-suite/bugs/closed/3956.v deleted file mode 100644 index 4957cc740d..0000000000 --- a/test-suite/bugs/closed/3956.v +++ /dev/null @@ -1,143 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-indices-matter"); mode: visual-line -*- *) -Set Universe Polymorphism. -Set Primitive Projections. -Close Scope nat_scope. - -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Arguments pair {A B} _ _. -Arguments fst {A B} _ / . -Arguments snd {A B} _ / . -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. - -Unset Strict Universe Declaration. - -Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. -Definition Type2 := Eval hnf in let gt := (Type1 : Type@{i}) in Type@{i}. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y" := (@paths _ x y) : type_scope. -Definition concat {A} {x y z : A} (p : x = y) (q : y = z) : x = z - := match p, q with idpath, idpath => idpath end. - -Definition path_prod {A B : Type} (z z' : A * B) -: (fst z = fst z') -> (snd z = snd z') -> (z = z'). -Proof. - destruct z, z'; simpl; intros [] []; reflexivity. -Defined. - -Module Type TypeM. - Parameter m : Type2. -End TypeM. - -Module ProdM (XM : TypeM) (YM : TypeM) <: TypeM. - Definition m := XM.m * YM.m. -End ProdM. - -Module Type FunctionM (XM YM : TypeM). - Parameter m : XM.m -> YM.m. -End FunctionM. - -Module IdmapM (XM : TypeM) <: FunctionM XM XM. - Definition m := (fun x => x) : XM.m -> XM.m. -End IdmapM. - -Module Type HomotopyM (XM YM : TypeM) (fM gM : FunctionM XM YM). - Parameter m : forall x, fM.m x = gM.m x. -End HomotopyM. - -Module ComposeM (XM YM ZM : TypeM) - (gM : FunctionM YM ZM) (fM : FunctionM XM YM) - <: FunctionM XM ZM. - Definition m := (fun x => gM.m (fM.m x)). -End ComposeM. - -Module Type CorecM (YM ZM : TypeM) (fM : FunctionM YM ZM) - (XM : TypeM) (gM : FunctionM XM ZM). - Parameter m : XM.m -> YM.m. - Parameter m_beta : forall x, fM.m (m x) = gM.m x. -End CorecM. - -Module Type CoindpathsM (YM ZM : TypeM) (fM : FunctionM YM ZM) - (XM : TypeM) (hM kM : FunctionM XM YM). - Module fhM := ComposeM XM YM ZM fM hM. - Module fkM := ComposeM XM YM ZM fM kM. - Declare Module mM (pM : HomotopyM XM ZM fhM fkM) - : HomotopyM XM YM hM kM. -End CoindpathsM. - -Module Type Comodality (XM : TypeM). - Parameter m : Type2. - Module mM <: TypeM. - Definition m := m. - End mM. - Parameter from : m -> XM.m. - Module fromM <: FunctionM mM XM. - Definition m := from. - End fromM. - Declare Module corecM : CorecM mM XM fromM. - Declare Module coindpathsM : CoindpathsM mM XM fromM. -End Comodality. - -Module Comodality_Theory (F : Comodality). - - Module F_functor_M (XM YM : TypeM) (fM : FunctionM XM YM) - (FXM : Comodality XM) (FYM : Comodality YM). - Module f_o_from_M <: FunctionM FXM.mM YM. - Definition m := fun x => fM.m (FXM.from x). - End f_o_from_M. - Module mM := FYM.corecM FXM.mM f_o_from_M. - Definition m := mM.m. - End F_functor_M. - - Module F_prod_cmp_M (XM YM : TypeM) - (FXM : Comodality XM) (FYM : Comodality YM). - Module PM := ProdM XM YM. - Module PFM := ProdM FXM FYM. - Module fstM <: FunctionM PM XM. - Definition m := @fst XM.m YM.m. - End fstM. - Module sndM <: FunctionM PM YM. - Definition m := @snd XM.m YM.m. - End sndM. - Module FPM := F PM. - Module FfstM := F_functor_M PM XM fstM FPM FXM. - Module FsndM := F_functor_M PM YM sndM FPM FYM. - Definition m : FPM.m -> PFM.m - := fun z => (FfstM.m z , FsndM.m z). - End F_prod_cmp_M. - - Module isequiv_F_prod_cmp_M - (XM YM : TypeM) - (FXM : Comodality XM) (FYM : Comodality YM). - (** The comparison map *) - Module cmpM := F_prod_cmp_M XM YM FXM FYM. - Module FPM := cmpM.FPM. - (** We construct an inverse to it using corecursion. *) - Module prod_from_M <: FunctionM cmpM.PFM cmpM.PM. - Definition m : cmpM.PFM.m -> cmpM.PM.m - := fun z => ( FXM.from (fst z) , FYM.from (snd z) ). - End prod_from_M. - Module cmpinvM <: FunctionM cmpM.PFM FPM - := FPM.corecM cmpM.PFM prod_from_M. - (** We prove the first homotopy *) - Module cmpinv_o_cmp_M <: FunctionM FPM FPM - := ComposeM FPM cmpM.PFM FPM cmpinvM cmpM. - Module idmap_FPM <: FunctionM FPM FPM - := IdmapM FPM. - Module cip_FPM := FPM.coindpathsM FPM cmpinv_o_cmp_M idmap_FPM. - Module cip_FPHM <: HomotopyM FPM cmpM.PM cip_FPM.fhM cip_FPM.fkM. - Definition m : forall x, cip_FPM.fhM.m@{i j} x = cip_FPM.fkM.m@{i j} x. - Proof. - intros x. - refine (concat (cmpinvM.m_beta@{i j} (cmpM.m@{i j} x)) _). - apply path_prod@{i i i}; simpl. - - exact (cmpM.FfstM.mM.m_beta@{i j} x). - - exact (cmpM.FsndM.mM.m_beta@{i j} x). - Defined. - End cip_FPHM. - End isequiv_F_prod_cmp_M. - -End Comodality_Theory. diff --git a/test-suite/bugs/closed/3957.v b/test-suite/bugs/closed/3957.v deleted file mode 100644 index e20a6e97f0..0000000000 --- a/test-suite/bugs/closed/3957.v +++ /dev/null @@ -1,6 +0,0 @@ -Ltac foo tac := tac. - -Goal True. -Proof. -foo subst. -Admitted. diff --git a/test-suite/bugs/closed/3960.v b/test-suite/bugs/closed/3960.v deleted file mode 100644 index 3527312486..0000000000 --- a/test-suite/bugs/closed/3960.v +++ /dev/null @@ -1,26 +0,0 @@ -Require Program.Tactics. - -Axiom foo : nat -> Prop. - -Axiom fooP : forall n, foo n. - -Class myClass (A: Type) := - { - bar : A -> Prop - }. - -Program Instance myInstance : myClass nat := - { - bar := foo - }. - -Class myClassP (A : Type) := - { - super :> myClass A; - barP : forall (a : A), bar a - }. - -Instance myInstanceP : myClassP nat := - { - barP := fooP - }. diff --git a/test-suite/bugs/closed/3974.v b/test-suite/bugs/closed/3974.v deleted file mode 100644 index 3d9e06b612..0000000000 --- a/test-suite/bugs/closed/3974.v +++ /dev/null @@ -1,7 +0,0 @@ -Module Type S. -End S. - -Module Type M (X : S). - Fail Module P (X : S). - (* Used to say: Anomaly: X already exists. Please report. *) - (* Should rather say now: Error: X already exists. *) diff --git a/test-suite/bugs/closed/3975.v b/test-suite/bugs/closed/3975.v deleted file mode 100644 index c7616b3ab6..0000000000 --- a/test-suite/bugs/closed/3975.v +++ /dev/null @@ -1,8 +0,0 @@ -Module Type S. End S. - -Module M (X:S). End M. - -Module Type P (X : S). - Print M. - (* Used to say: Anomaly: X already exists. Please report. *) - (* Should rather : print something :-) *) diff --git a/test-suite/bugs/closed/3978.v b/test-suite/bugs/closed/3978.v deleted file mode 100644 index 26e021e719..0000000000 --- a/test-suite/bugs/closed/3978.v +++ /dev/null @@ -1,27 +0,0 @@ -Require Import Structures.OrderedType. -Require Import Structures.OrderedTypeEx. - -Module Type M. Parameter X : Type. - -Declare Module Export XOrd : OrderedType - with Definition t := X - with Definition eq := @Logic.eq X. -End M. - -Module M' : M. - Definition X := nat. - - Module XOrd := Nat_as_OT. -End M'. - -Module Type MyOt. - Parameter t : Type. - Parameter eq : t -> t -> Prop. -End MyOt. - -Module Type M2. Parameter X : Type. - -Declare Module Export XOrd : MyOt - with Definition t := X - with Definition eq := @Logic.eq X. -End M2. diff --git a/test-suite/bugs/closed/3993.v b/test-suite/bugs/closed/3993.v deleted file mode 100644 index 086d8dd0f3..0000000000 --- a/test-suite/bugs/closed/3993.v +++ /dev/null @@ -1,3 +0,0 @@ -(* Test smooth failure on not fully applied term to destruct with eqn: given *) -Goal True. -Fail induction S eqn:H. diff --git a/test-suite/bugs/closed/3998.v b/test-suite/bugs/closed/3998.v deleted file mode 100644 index e17550e904..0000000000 --- a/test-suite/bugs/closed/3998.v +++ /dev/null @@ -1,24 +0,0 @@ -Class FieldType (F : Set) := mkFieldType { fldTy: F -> Set }. -Hint Mode FieldType + : typeclass_instances. (* The F parameter is an input *) - -Inductive I1 := C. -Inductive I2 := . - -Instance I1FieldType : FieldType I1 := { fldTy := I1_rect _ bool }. -Instance I2FieldType : FieldType I2 := { fldTy := I2_rect _ }. - -Definition RecordOf F (FT: FieldType F) := forall f:F, fldTy f. - -Class MapOps (M K : Set) := { - tgtTy: K -> Set; - update: M -> forall k:K, tgtTy k -> M -}. - -Instance RecordMapOps F (FT: FieldType F) : MapOps (RecordOf F FT) F := -{ tgtTy := fldTy; update := fun r (f: F) (x: fldTy f) z => r z }. - -Axiom ex : RecordOf _ I1FieldType. - -Definition works := (fun ex' => update ex' C true) (update ex C false). -Set Typeclasses Debug. -Definition doesnt := update (update ex C false) C true. diff --git a/test-suite/bugs/closed/4001.v b/test-suite/bugs/closed/4001.v deleted file mode 100644 index 25d78f4b0e..0000000000 --- a/test-suite/bugs/closed/4001.v +++ /dev/null @@ -1,18 +0,0 @@ -(* Computing the type constraints to be satisfied when building the - return clause of a match with a match *) - -Set Implicit Arguments. -Set Asymmetric Patterns. - -Variable A : Type. -Variable typ : A -> Type. - -Inductive t : list A -> Type := -| snil : t nil -| scons : forall (x : A) (e : typ x) (lx : list A) (le : t lx), t (x::lx). - -Definition car (x:A) (lx : list A) (s: t (x::lx)) : typ x := - match s in t l' with - | snil => False - | scons _ e _ _ => e - end. diff --git a/test-suite/bugs/closed/4012.v b/test-suite/bugs/closed/4012.v deleted file mode 100644 index 1748e3baad..0000000000 --- a/test-suite/bugs/closed/4012.v +++ /dev/null @@ -1,5 +0,0 @@ -Goal (forall T : Type, T = T) -> Type. -Proof. - intro H. - Fail specialize (H _). -Abort. diff --git a/test-suite/bugs/closed/4016.v b/test-suite/bugs/closed/4016.v deleted file mode 100644 index 41cb1a8884..0000000000 --- a/test-suite/bugs/closed/4016.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Setoid. - -Parameter eq : relation nat. -Declare Instance Equivalence_eq : Equivalence eq. - -Lemma foo : forall z, eq z 0 -> forall x, eq x 0 -> eq z x. -Proof. -intros z Hz x Hx. -rewrite <- Hx in Hz. -destruct z. -Abort. - diff --git a/test-suite/bugs/closed/4017.v b/test-suite/bugs/closed/4017.v deleted file mode 100644 index aa810f4f0e..0000000000 --- a/test-suite/bugs/closed/4017.v +++ /dev/null @@ -1,8 +0,0 @@ -Set Implicit Arguments. - -(* Use of implicit arguments was lost in multiple variable declarations *) -Variables - (A1 : Type) - (A2 : forall (x1 : A1), Type) - (A3 : forall (x1 : A1) (x2 : A2 x1), Type) - (A4 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type). diff --git a/test-suite/bugs/closed/4018.v b/test-suite/bugs/closed/4018.v deleted file mode 100644 index 8895e09e02..0000000000 --- a/test-suite/bugs/closed/4018.v +++ /dev/null @@ -1,3 +0,0 @@ -(* Catching PatternMatchingFailure was lost at some point *) -Goal nat -> True. -Fail intros [=]. diff --git a/test-suite/bugs/closed/4031.v b/test-suite/bugs/closed/4031.v deleted file mode 100644 index 6c23baffa0..0000000000 --- a/test-suite/bugs/closed/4031.v +++ /dev/null @@ -1,14 +0,0 @@ -Definition something (P:Type) (e:P) := e. - -Inductive myunit : Set := mytt. - (* Proof below works when definition is in Type, - however builtin types such as unit are in Set. *) - -Lemma demo_hide_generic : - let x := mytt in x = x. -Proof. - intros. - change mytt with (@something _ mytt) in x. - subst x. (* Proof works if this line is removed *) - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/4034.v b/test-suite/bugs/closed/4034.v deleted file mode 100644 index 3f7be4d1c7..0000000000 --- a/test-suite/bugs/closed/4034.v +++ /dev/null @@ -1,25 +0,0 @@ -(* This checks compatibility of interpretation scope used for exact - between 8.4 and 8.5. See discussion at - https://coq.inria.fr/bugs/show_bug.cgi?id=4034. It is not clear - what we would like exactly, but certainly, if exact is interpreted - in a special scope, it should be interpreted consistently so also - in ltac code. *) - -Record Foo := {}. -Bind Scope foo_scope with Foo. -Notation "!" := Build_Foo : foo_scope. -Notation "!" := 1 : core_scope. -Open Scope foo_scope. -Open Scope core_scope. - -Goal Foo. - Fail exact !. -(* ... but maybe will we want it to succeed eventually if we ever - would be able to make it working the same in - -Ltac myexact e := exact e. - -Goal Foo. - myexact !. -Defined. -*) diff --git a/test-suite/bugs/closed/4035.v b/test-suite/bugs/closed/4035.v deleted file mode 100644 index ec246d097b..0000000000 --- a/test-suite/bugs/closed/4035.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Supporting tactic notations within Ltac in the presence of an - "ident" entry which does not expect a fresh ident *) -(* Of course, this is a matter of convention of what "ident" is - supposed to denote, but in practice, it seems more convenient to - have less constraints on ident at interpretation time, as - otherwise more ad hoc entries would be necessary (as e.g. a special - "quantified_hypothesis" entry for dependent destruction). *) -Require Import Program. -Goal nat -> Type. - intro x. - lazymatch goal with - | [ x : nat |- _ ] => dependent destruction x - end. diff --git a/test-suite/bugs/closed/4046.v b/test-suite/bugs/closed/4046.v deleted file mode 100644 index 8f8779b7b2..0000000000 --- a/test-suite/bugs/closed/4046.v +++ /dev/null @@ -1,6 +0,0 @@ -Module Import Foo. - Class Foo := { foo : Type }. -End Foo. - -Instance f : Foo := { foo := nat }. (* works fine *) -Instance f' : Foo.Foo := { Foo.foo := nat }. diff --git a/test-suite/bugs/closed/4057.v b/test-suite/bugs/closed/4057.v deleted file mode 100644 index 4f0e696c9a..0000000000 --- a/test-suite/bugs/closed/4057.v +++ /dev/null @@ -1,210 +0,0 @@ -Require Coq.Strings.String. - -Set Implicit Arguments. - -Axiom falso : False. -Ltac admit := destruct falso. - -Reserved Notation "[ x ]". - -Record string_like (CharType : Type) := - { - String :> Type; - Singleton : CharType -> String where "[ x ]" := (Singleton x); - Empty : String; - Concat : String -> String -> String where "x ++ y" := (Concat x y); - bool_eq : String -> String -> bool; - bool_eq_correct : forall x y : String, bool_eq x y = true <-> x = y; - Length : String -> nat - }. - -Delimit Scope string_like_scope with string_like. -Bind Scope string_like_scope with String. -Arguments Length {_%type_scope _} _%string_like. -Infix "++" := (@Concat _ _) : string_like_scope. - -Definition str_le {CharType} {String : string_like CharType} (s1 s2 : String) - := Length s1 < Length s2 \/ s1 = s2. -Infix "≤s" := str_le (at level 70, right associativity). - -Module Export ContextFreeGrammar. - Import Coq.Strings.String. - Import Coq.Lists.List. - - Section cfg. - Variable CharType : Type. - - Section definitions. - - Inductive item := - | NonTerminal (name : string). - - Definition production := list item. - Definition productions := list production. - - Record grammar := - { - Start_symbol :> string; - Lookup :> string -> productions - }. - End definitions. - - Section parse. - Variable String : string_like CharType. - Variable G : grammar. - - Inductive parse_of : String -> productions -> Type := - | ParseHead : forall str pat pats, parse_of_production str pat - -> parse_of str (pat::pats) - | ParseTail : forall str pat pats, parse_of str pats - -> parse_of str (pat::pats) - with parse_of_production : String -> production -> Type := - | ParseProductionCons : forall str pat strs pats, - parse_of_item str pat - -> parse_of_production strs pats - -> parse_of_production (str ++ strs) (pat::pats) - with parse_of_item : String -> item -> Type := - | ParseNonTerminal : forall name str, parse_of str (Lookup G name) - -> parse_of_item str (NonTerminal -name). - End parse. - End cfg. - -End ContextFreeGrammar. -Module Export ContextFreeGrammarProperties. - - Section cfg. - Context CharType (String : string_like CharType) (G : grammar) - (P : String.string -> Type). - - Fixpoint Forall_parse_of {str pats} (p : parse_of String G str pats) - := match p with - | @ParseHead _ _ _ str pat pats p' - => Forall_parse_of_production p' - | @ParseTail _ _ _ _ _ _ p' - => Forall_parse_of p' - end - with Forall_parse_of_production {str pat} (p : parse_of_production String G -str pat) - := let Forall_parse_of_item {str it} (p : parse_of_item String G str -it) - := match p return Type with - | @ParseNonTerminal _ _ _ name str p' - => (P name * Forall_parse_of p')%type - end in - match p return Type with - | @ParseProductionCons _ _ _ str pat strs pats p' p'' - => (Forall_parse_of_item p' * Forall_parse_of_production -p'')%type - end. - - Definition Forall_parse_of_item {str it} (p : parse_of_item String G str it) - := match p return Type with - | @ParseNonTerminal _ _ _ name str p' - => (P name * Forall_parse_of p')%type - end. - End cfg. - -End ContextFreeGrammarProperties. - -Module Export DependentlyTyped. - Import Coq.Strings.String. - - Section recursive_descent_parser. - - Class parser_computational_predataT := - { nonterminal_names_listT : Type; - initial_nonterminal_names_data : nonterminal_names_listT; - is_valid_nonterminal_name : nonterminal_names_listT -> string -> bool; - remove_nonterminal_name : nonterminal_names_listT -> string -> -nonterminal_names_listT }. - - End recursive_descent_parser. - -End DependentlyTyped. -Import Coq.Strings.String. -Import Coq.Lists.List. - -Section cfg. - Context CharType (String : string_like CharType) (G : grammar). - Context (names_listT : Type) - (initial_names_data : names_listT) - (is_valid_name : names_listT -> string -> bool) - (remove_name : names_listT -> string -> names_listT). - - Inductive minimal_parse_of - : forall (str0 : String) (valid : names_listT) - (str : String), - productions -> Type := - | MinParseHead : forall str0 valid str pat pats, - @minimal_parse_of_production str0 valid str pat - -> @minimal_parse_of str0 valid str (pat::pats) - | MinParseTail : forall str0 valid str pat pats, - @minimal_parse_of str0 valid str pats - -> @minimal_parse_of str0 valid str (pat::pats) - with minimal_parse_of_production - : forall (str0 : String) (valid : names_listT) - (str : String), - production -> Type := - | MinParseProductionNil : forall str0 valid, - @minimal_parse_of_production str0 valid (Empty _) -nil - | MinParseProductionCons : forall str0 valid str strs pat pats, - str ++ strs ≤s str0 - -> @minimal_parse_of_item str0 valid str pat - -> @minimal_parse_of_production str0 valid strs -pats - -> @minimal_parse_of_production str0 valid (str -++ strs) (pat::pats) - with minimal_parse_of_item - : forall (str0 : String) (valid : names_listT) - (str : String), - item -> Type := - | MinParseNonTerminal - : forall str0 valid str name, - @minimal_parse_of_name str0 valid str name - -> @minimal_parse_of_item str0 valid str (NonTerminal name) - with minimal_parse_of_name - : forall (str0 : String) (valid : names_listT) - (str : String), - string -> Type := - | MinParseNonTerminalStrLt - : forall str0 valid name str, - @minimal_parse_of str initial_names_data str (Lookup G name) - -> @minimal_parse_of_name str0 valid str name - | MinParseNonTerminalStrEq - : forall str valid name, - @minimal_parse_of str (remove_name valid name) str (Lookup G name) - -> @minimal_parse_of_name str valid str name. - Definition parse_of_item_name__of__minimal_parse_of_name - : forall {str0 valid str name} (p : @minimal_parse_of_name str0 valid str -name), - parse_of_item String G str (NonTerminal name). - Proof. - admit. - Defined. - -End cfg. - -Section recursive_descent_parser. - Context (CharType : Type) - (String : string_like CharType) - (G : grammar). - Context {premethods : parser_computational_predataT}. - Let P : string -> Prop. - Proof. - admit. - Defined. - - Let mp_parse_nonterminal_name str0 valid str nonterminal_name - := { p' : minimal_parse_of_name String G initial_nonterminal_names_data -remove_nonterminal_name str0 valid str nonterminal_name & Forall_parse_of_item -P (parse_of_item_name__of__minimal_parse_of_name p') }. - - Goal False. - Proof. - clear -mp_parse_nonterminal_name. - subst P. - simpl in *. - admit. - Qed. diff --git a/test-suite/bugs/closed/4069.v b/test-suite/bugs/closed/4069.v deleted file mode 100644 index 668f6bb428..0000000000 --- a/test-suite/bugs/closed/4069.v +++ /dev/null @@ -1,106 +0,0 @@ - -Lemma test1 : -forall (v : nat) (f g : nat -> nat), -f v = g v. -intros. f_equal. -(* -Goal in v8.5: f v = g v -Goal in v8.4: v = v -> f v = g v -Expected: f = g -*) -Admitted. - -Lemma test2 : -forall (v u : nat) (f g : nat -> nat), -f v = g u. -intros. f_equal. -(* -In both v8.4 And v8.5 -Goal 1: v = u -> f v = g u -Goal 2: v = u - -Expected Goal 1: f = g -Expected Goal 2: v = u -*) -Admitted. - -Lemma test3 : -forall (v : nat) (u : list nat) (f : nat -> nat) (g : list nat -> nat), -f v = g u. -intros. f_equal. -(* -In both v8.4 And v8.5, the goal is unchanged. -*) -Admitted. - -Require Import List. -Lemma foo n (l k : list nat) : k ++ skipn n l = skipn n l. -Proof. f_equal. -(* - 8.4: leaves the goal unchanged, i.e. k ++ skipn n l = skipn n l - 8.5: 2 goals, skipn n l = l -> k ++ skipn n l = skipn n l - and skipn n l = l -*) -Abort. - -Require Import List. -Fixpoint replicate {A} (n : nat) (x : A) : list A := - match n with 0 => nil | S n => x :: replicate n x end. -Lemma bar {A} n m (x : A) : - skipn n (replicate m x) = replicate (m - n) x -> - skipn n (replicate m x) = replicate (m - n) x. -Proof. intros. f_equal. -(* 8.5: one goal, n = m - n *) -Abort. - -Variable F : nat -> Set. -Variable X : forall n, F (n + 1). - -Definition sequator{X Y: Set}{eq:X=Y}(x:X) : Y := eq_rec _ _ x _ eq. -Definition tequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq. -Polymorphic Definition pequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq. - -Goal {n:nat & F (S n)}. -eexists. -unshelve eapply (sequator (X _)). -f_equal. (*behaves*) -Undo 2. -unshelve eapply (pequator (X _)). -f_equal. (*behaves*) -Undo 2. -unshelve eapply (tequator (X _)). -f_equal. (*behaves now *) -Focus 2. exact 0. -simpl. -reflexivity. -Defined. - -(* Part 2: modulo casts introduced by refine due to reductions in goals *) - -Goal {n:nat & F (S n)}. -eexists. -(*misbehaves, although same goal as above*) -Set Printing All. -unshelve refine (sequator (X _)); revgoals. -2:exact 0. reflexivity. -Undo 3. -unshelve refine (pequator (X _)); revgoals. -f_equal. -Undo 2. -unshelve refine (tequator (X _)); revgoals. -f_equal. -Admitted. - -Goal @eq Set nat nat. -congruence. -Qed. - -Goal @eq Type nat nat. -congruence. -Qed. - -Variable T : Type. - -Goal @eq Type T T. -congruence. -Qed. diff --git a/test-suite/bugs/closed/4078.v b/test-suite/bugs/closed/4078.v deleted file mode 100644 index 236cd2fbb1..0000000000 --- a/test-suite/bugs/closed/4078.v +++ /dev/null @@ -1,14 +0,0 @@ -Module Type S. - -Axiom foo : nat. - -End S. - -Module M : S. - -Definition bar := 0. -Definition foo := bar. - -End M. - -Print All Dependencies M.foo. diff --git a/test-suite/bugs/closed/4089.v b/test-suite/bugs/closed/4089.v deleted file mode 100644 index fc1c504f14..0000000000 --- a/test-suite/bugs/closed/4089.v +++ /dev/null @@ -1,375 +0,0 @@ -Unset Strict Universe Declaration. -Require Import TestSuite.admit. -(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 6522 lines to 318 lines, then from 1139 lines to 361 lines *) -(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) -Open Scope type_scope. - -Global Set Universe Polymorphism. -Module Export Datatypes. - -Set Implicit Arguments. - -Record prod (A B : Type) := pair { fst : A ; snd : B }. - -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. - -End Datatypes. -Module Export Specif. - -Set Implicit Arguments. - -Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. - -Notation sigT := sig (only parsing). -Notation existT := exist (only parsing). - -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. - -Notation projT1 := proj1_sig (only parsing). -Notation projT2 := proj2_sig (only parsing). - -End Specif. - -Ltac rapply p := - refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _) || - refine (p _ _ _ _ _) || - refine (p _ _ _ _) || - refine (p _ _ _) || - refine (p _ _) || - refine (p _) || - refine p. - -Local Unset Elimination Schemes. - -Definition relation (A : Type) := A -> A -> Type. - -Class Symmetric {A} (R : relation A) := - symmetry : forall x y, R x y -> R y x. - -Class Transitive {A} (R : relation A) := - transitivity : forall x y z, R x y -> R y z -> R x z. - -Tactic Notation "etransitivity" open_constr(y) := - let R := match goal with |- ?R ?x ?z => constr:(R) end in - let x := match goal with |- ?R ?x ?z => constr:(x) end in - let z := match goal with |- ?R ?x ?z => constr:(z) end in - let pre_proof_term_head := constr:(@transitivity _ R _) in - let proof_term_head := (eval cbn in pre_proof_term_head) in - refine (proof_term_head x y z _ _); [ change (R x y) | change (R y z) ]. - -Ltac transitivity x := etransitivity x. - -Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. - -Notation idmap := (fun x => x). -Delimit Scope function_scope with function. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Open Scope fibration_scope. -Open Scope function_scope. - -Notation "( x ; y )" := (existT _ x y) : fibration_scope. - -Notation pr1 := projT1. -Notation pr2 := projT2. - -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Scheme paths_ind := Induction for paths Sort Type. - -Definition paths_rect := paths_ind. - -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Local Open Scope path_scope. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Arguments concat {A x y z} p q : simpl nomatch. - -Notation "1" := idpath : path_scope. - -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. - -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. - -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) - : f == g - := fun x => match h with idpath => 1 end. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) -}. - -Arguments eisretr {A B}%type_scope f%function_scope {_} _. -Arguments eissect {A B}%type_scope f%function_scope {_} _. -Arguments eisadj {A B}%type_scope f%function_scope {_} _. - -Record Equiv A B := BuildEquiv { - equiv_fun : A -> B ; - equiv_isequiv : IsEquiv equiv_fun -}. - -Coercion equiv_fun : Equiv >-> Funclass. - -Global Existing Instance equiv_isequiv. - -Bind Scope equiv_scope with Equiv. - -Notation "A <~> B" := (Equiv A B) (at level 85) : type_scope. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. - -Inductive Unit : Set := - tt : Unit. - -Ltac done := - trivial; intros; solve - [ repeat first - [ solve [trivial] - | solve [symmetry; trivial] - | reflexivity - - | contradiction - | split ] - | match goal with - H : ~ _ |- _ => solve [destruct H; trivial] - end ]. -Tactic Notation "by" tactic(tac) := - tac; done. - -Definition concat_p1 {A : Type} {x y : A} (p : x = y) : - p @ 1 = p - := - match p with idpath => 1 end. - -Definition concat_1p {A : Type} {x y : A} (p : x = y) : - 1 @ p = p - := - match p with idpath => 1 end. - -Definition ap_pp {A B : Type} (f : A -> B) {x y z : A} (p : x = y) (q : y = z) : - ap f (p @ q) = (ap f p) @ (ap f q) - := - match q with - idpath => - match p with idpath => 1 end - end. - -Definition ap_compose {A B C : Type} (f : A -> B) (g : B -> C) {x y : A} (p : x = y) : - ap (g o f) p = ap g (ap f p) - := - match p with idpath => 1 end. - -Definition concat_A1p {A : Type} {f : A -> A} (p : forall x, f x = x) {x y : A} (q : x = y) : - (ap f q) @ (p y) = (p x) @ q - := - match q with - | idpath => concat_1p _ @ ((concat_p1 _) ^) - end. - -Definition concat2 {A} {x y z : A} {p p' : x = y} {q q' : y = z} (h : p = p') (h' : q = q') - : p @ q = p' @ q' -:= match h, h' with idpath, idpath => 1 end. - -Notation "p @@ q" := (concat2 p q)%path (at level 20) : path_scope. - -Definition whiskerL {A : Type} {x y z : A} (p : x = y) - {q r : y = z} (h : q = r) : p @ q = p @ r -:= 1 @@ h. - -Definition ap02 {A B : Type} (f:A->B) {x y:A} {p q:x=y} (r:p=q) : ap f p = ap f q - := match r with idpath => 1 end. -Module Export Equivalences. - -Generalizable Variables A B C f g. - -Global Instance isequiv_idmap (A : Type) : IsEquiv idmap | 0 := - BuildIsEquiv A A idmap idmap (fun _ => 1) (fun _ => 1) (fun _ => 1). - -Definition equiv_idmap (A : Type) : A <~> A := BuildEquiv A A idmap _. - -Arguments equiv_idmap {A} , A. - -Notation "1" := equiv_idmap : equiv_scope. - -Global Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} - : IsEquiv (compose g f) | 1000 - := BuildIsEquiv A C (compose g f) - (compose f^-1 g^-1) - (fun c => ap g (eisretr f (g^-1 c)) @ eisretr g c) - (fun a => ap (f^-1) (eissect g (f a)) @ eissect f a) - (fun a => - (whiskerL _ (eisadj g (f a))) @ - (ap_pp g _ _)^ @ - ap02 g - ( (concat_A1p (eisretr f) (eissect g (f a)))^ @ - (ap_compose f^-1 f _ @@ eisadj f a) @ - (ap_pp f _ _)^ - ) @ - (ap_compose f g _)^ - ). - -Definition equiv_compose {A B C : Type} (g : B -> C) (f : A -> B) - `{IsEquiv B C g} `{IsEquiv A B f} - : A <~> C - := BuildEquiv A C (compose g f) _. - -Global Instance transitive_equiv : Transitive Equiv | 0 := - fun _ _ _ f g => equiv_compose g f. - -Theorem equiv_inverse {A B : Type} : (A <~> B) -> (B <~> A). -admit. -Defined. - -Global Instance symmetric_equiv : Symmetric Equiv | 0 := @equiv_inverse. - -End Equivalences. - -Definition path_prod_uncurried {A B : Type} (z z' : A * B) - (pq : (fst z = fst z') * (snd z = snd z')) - : (z = z'). -admit. -Defined. - -Global Instance isequiv_path_prod {A B : Type} {z z' : A * B} -: IsEquiv (path_prod_uncurried z z') | 0. -admit. -Defined. - -Definition equiv_path_prod {A B : Type} (z z' : A * B) - : (fst z = fst z') * (snd z = snd z') <~> (z = z') - := BuildEquiv _ _ (path_prod_uncurried z z') _. - -Generalizable Variables X A B C f g n. - -Definition functor_sigma `{P : A -> Type} `{Q : B -> Type} - (f : A -> B) (g : forall a, P a -> Q (f a)) -: sigT P -> sigT Q - := fun u => (f u.1 ; g u.1 u.2). - -Global Instance isequiv_functor_sigma `{P : A -> Type} `{Q : B -> Type} - `{IsEquiv A B f} `{forall a, @IsEquiv (P a) (Q (f a)) (g a)} -: IsEquiv (functor_sigma f g) | 1000. -admit. -Defined. - -Definition equiv_functor_sigma `{P : A -> Type} `{Q : B -> Type} - (f : A -> B) `{IsEquiv A B f} - (g : forall a, P a -> Q (f a)) - `{forall a, @IsEquiv (P a) (Q (f a)) (g a)} -: sigT P <~> sigT Q - := BuildEquiv _ _ (functor_sigma f g) _. - -Definition equiv_functor_sigma' `{P : A -> Type} `{Q : B -> Type} - (f : A <~> B) - (g : forall a, P a <~> Q (f a)) -: sigT P <~> sigT Q - := equiv_functor_sigma f g. - -Definition equiv_functor_sigma_id `{P : A -> Type} `{Q : A -> Type} - (g : forall a, P a <~> Q a) -: sigT P <~> sigT Q - := equiv_functor_sigma' 1 g. - -Definition Bip : Type := { C : Type & C * C }. - -Definition BipMor (X Y : Bip) : Type := - match X, Y with (C;(c0,c1)), (D;(d0,d1)) => - { f : C -> D & (f c0 = d0) * (f c1 = d1) } - end. - -Definition bipmor2map {X Y : Bip} : BipMor X Y -> X.1 -> Y.1 := - match X, Y with (C;(c0,c1)), (D;(d0,d1)) => fun i => - match i with (f;_) => f end - end. - -Definition bipidmor {X : Bip} : BipMor X X := - match X with (C;(c0,c1)) => (idmap; (1, 1)) end. - -Definition bipcompmor {X Y Z : Bip} : BipMor X Y -> BipMor Y Z -> BipMor X Z := - match X, Y, Z with (C;(c0,c1)), (D;(d0,d1)), (E;(e0,e1)) => fun i j => - match i, j with (f;(f0,f1)), (g;(g0,g1)) => - (g o f; (ap g f0 @ g0, ap g f1 @ g1)) - end - end. - -Definition isbipequiv {X Y : Bip} (i : BipMor X Y) : Type := - { l : BipMor Y X & bipcompmor i l = bipidmor } * - { r : BipMor Y X & bipcompmor r i = bipidmor }. - -Lemma bipequivEQequiv : forall {X Y : Bip} (i : BipMor X Y), - isbipequiv i <~> IsEquiv (bipmor2map i). -Proof. -assert (equivcompmor : forall {X Y : Bip} (i : BipMor X Y) j, -(bipcompmor i j = bipidmor) <~> Unit). - intros; set (U := X); set (V := Y); destruct X as [C [c0 c1]], Y as [D [d0 d1]]. - transitivity { n : (bipcompmor i j).1 = (@bipidmor U).1 & - (bipcompmor i j).2 = transport (fun h => (h c0 = c0) * (h c1 = c1)) n^ (@bipidmor U).2}. - admit. - destruct i as [f [f0 f1]]; destruct j as [g [g0 g1]]. - - transitivity { n : g o f = idmap & (ap g f0 @ g0 = apD10 n c0 @ 1) * - (ap g f1 @ g1 = apD10 n c1 @ 1)}. - apply equiv_functor_sigma_id; intro n. - assert (Ggen : forall (h0 h1 : C -> C) (p : h0 = h1) u0 u1 v0 v1, - ((u0, u1) = transport (fun h => (h c0 = c0) * (h c1 = c1)) p^ (v0, v1)) <~> - (u0 = apD10 p c0 @ v0) * (u1 = apD10 p c1 @ v1)). - induction p; intros; simpl; rewrite !concat_1p; apply symmetry. - by apply (equiv_path_prod (u0,u1) (v0,v1)). - rapply Ggen. - pose (@paths C). - Check (@paths C). - Undo. - Check (@paths C). (* Toplevel input, characters 0-17: -Error: Illegal application: -The term "@paths" of type "forall A : Type, A -> A -> Type" -cannot be applied to the term - "C" : "Type" -This term has type "Type@{Top.892}" which should be coercible to - "Type@{Top.882}". -*) diff --git a/test-suite/bugs/closed/4095.v b/test-suite/bugs/closed/4095.v deleted file mode 100644 index bc9380f90d..0000000000 --- a/test-suite/bugs/closed/4095.v +++ /dev/null @@ -1,87 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines, then from 92 lines to 79 lines *) -(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) -Require Import Coq.Setoids.Setoid. -Generalizable All Variables. -Axiom admit : forall {T}, T. -Ltac admit := apply admit. -Class Equiv (A : Type) := equiv : relation A. -Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. -Class ILogicOps Frm := { lentails: relation Frm; - ltrue: Frm; - land: Frm -> Frm -> Frm; - lor: Frm -> Frm -> Frm }. -Infix "|--" := lentails (at level 79, no associativity). -Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }. -Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P. -Infix "-|-" := lequiv (at level 85, no associativity). -Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit. -Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }. -Section ILogic_Fun. - Context (T: Type) `{TType: type T}. - Context `{IL: ILogic Frm}. - Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. - Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. -End ILogic_Fun. -Arguments ILFunFrm _ {e} _ {ILOps}. -Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; - ltrue := True; - land P Q := P /\ Q; - lor P Q := P \/ Q |}. -Axiom Action : Set. -Definition Actions := list Action. -Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }. -Definition OPred := ILFunFrm Actions Prop. -Local Existing Instance ILFun_Ops. -Local Existing Instance ILFun_ILogic. -Definition catOP (P Q: OPred) : OPred := admit. -Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. -admit. -Defined. -Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. -Class IsPointed (T : Type) := point : T. -Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). -Record PointedOPred := mkPointedOPred { - OPred_pred :> OPred; - OPred_inhabited: IsPointed_OPred OPred_pred - }. -Existing Instance OPred_inhabited. -Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred - := {| OPred_pred := O ; OPred_inhabited := _ |}. -Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit. -Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) - (tr : T -> T) (O2 : PointedOPred) (x : T) - (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0), - exists e1 e2, - catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2. - intros; do 2 esplit. - rewrite <- catOPA. - lazymatch goal with - | |- ?R (?f ?a ?b) (?f ?a' ?b') => - let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred) - (@Morphisms.respectful OPred (OPred -> OPred) - (@lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop)) - (@lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==> - @lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP - catOP_entails_m_Proper a a' H b b' H') in - pose P; - refine (P _ _) - end. - Undo. - Fail lazymatch goal with - | |- ?R (?f ?a ?b) (?f ?a' ?b') => - let P := constr:(fun H H' => Morphisms.proper_prf a a' H b b' H') in - set(p:=P) - end. (* Toplevel input, characters 15-182: -Error: Cannot infer an instance of type -"PointedOPred" for the variable p in environment: -T : Type -O0 : T -> OPred -O1 : T -> PointedOPred -tr : T -> T -O2 : PointedOPred -x0 : T -H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0 *) diff --git a/test-suite/bugs/closed/4097.v b/test-suite/bugs/closed/4097.v deleted file mode 100644 index 183b860d1f..0000000000 --- a/test-suite/bugs/closed/4097.v +++ /dev/null @@ -1,65 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 6082 lines to 81 lines, then from 436 lines to 93 lines *) -(* coqc version 8.5beta1 (February 2015) compiled on Feb 27 2015 15:10:37 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (fc1b3ef9d7270938cd83c524aae0383093b7a4b5) *) -Global Set Primitive Projections. -Record sigT {A} (P : A -> Type) := exist { projT1 : A ; projT2 : P projT1 }. -Arguments projT1 {A P} _ / . -Arguments projT2 {A P} _ / . -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Open Scope path_scope. -Open Scope fibration_scope. -Notation "( x ; y )" := (exist _ _ x y) : fibration_scope. -Notation pr1 := projT1. -Notation pr2 := projT2. -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. -Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): - p # (f x) = f y - := - match p with idpath => idpath end. -Lemma transport_compose {A B} {x y : A} (P : B -> Type) (f : A -> B) - (p : x = y) (z : P (f x)) - : transport (fun x => P (f x)) p z = transport P (ap f p) z. -admit. -Defined. -Generalizable Variables X A B C f g n. -Definition pr1_path `{P : A -> Type} {u v : sigT P} (p : u = v) -: u.1 = v.1 - := ap pr1 p. -Notation "p ..1" := (pr1_path p) (at level 3) : fibration_scope. -Definition pr2_path `{P : A -> Type} {u v : sigT P} (p : u = v) -: p..1 # u.2 = v.2 - := (transport_compose P pr1 p u.2)^ - @ (@apD {x:A & P x} _ pr2 _ _ p). -Notation "p ..2" := (pr2_path p) (at level 3) : fibration_scope. -Definition path_path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (p q : u = v) - (rs : {r : p..1 = q..1 & transport (fun x => transport P x u.2 = v.2) r p..2 = q..2}) -: p = q. -admit. -Defined. -Set Debug Unification. -Definition path_path_sigma {A : Type} (P : A -> Type) (u v : sigT P) - (p q : u = v) - (r : p..1 = q..1) - (s : transport (fun x => transport P x u.2 = v.2) r p..2 = q..2) -: p = q - := path_path_sigma_uncurried P u v p q (r; s). diff --git a/test-suite/bugs/closed/4101.v b/test-suite/bugs/closed/4101.v deleted file mode 100644 index 75a26a0670..0000000000 --- a/test-suite/bugs/closed/4101.v +++ /dev/null @@ -1,19 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 10940 lines to 152 lines, then from 509 lines to 163 lines, then from 178 lines to 66 lines *) -(* coqc version 8.5beta1 (March 2015) compiled on Mar 2 2015 18:53:10 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (e77f178e60918f14eacd1ec0364a491d4cfd0f3f) *) - -Global Set Primitive Projections. -Set Implicit Arguments. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), - (forall x, f x = g x) -> f = g. -Lemma sigT_obj_eq -: forall (T : Type) (T0 : T -> Type) - (s s0 : forall s : sigT T0, - sigT (fun _ : T0 (projT1 s) => unit) -> - sigT (fun _ : T0 (projT1 s) => unit)), - s0 = s. -Proof. - intros. - Set Debug Tactic Unification. - apply path_forall. diff --git a/test-suite/bugs/closed/4103.v b/test-suite/bugs/closed/4103.v deleted file mode 100644 index 92cc0279ac..0000000000 --- a/test-suite/bugs/closed/4103.v +++ /dev/null @@ -1,12 +0,0 @@ -Set Primitive Projections. - -CoInductive stream A := { hd : A; tl : stream A }. - -CoFixpoint ticks (n : nat) : stream unit := {| hd := tt; tl := ticks n |}. - -Lemma expand : exists n : nat, (ticks n) = (ticks n).(tl _). -Proof. - eexists. - (* Set Debug Tactic Unification. *) - (* Set Debug RAKAM. *) - reflexivity. diff --git a/test-suite/bugs/closed/4116.v b/test-suite/bugs/closed/4116.v deleted file mode 100644 index 5932c9c56e..0000000000 --- a/test-suite/bugs/closed/4116.v +++ /dev/null @@ -1,383 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 13191 lines to 1315 lines, then from 1601 lines to 595 lines, then from 585 lines to 379 lines *) -(* coqc version 8.5beta1 (March 2015) compiled on Mar 3 2015 3:50:31 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ac62cda8a4f488b94033b108c37556877232137a) *) - -Axiom admit : False. -Ltac admit := exfalso; exact admit. - -Global Set Primitive Projections. - -Notation projT1 := proj1_sig (only parsing). -Notation projT2 := proj2_sig (only parsing). - -Definition relation (A : Type) := A -> A -> Type. - -Class Reflexive {A} (R : relation A) := - reflexivity : forall x : A, R x x. - -Class Symmetric {A} (R : relation A) := - symmetry : forall x y, R x y -> R y x. - -Notation idmap := (fun x => x). -Delimit Scope function_scope with function. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Open Scope path_scope. -Open Scope fibration_scope. -Open Scope function_scope. - -Notation pr1 := projT1. -Notation pr2 := projT2. - -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Global Instance symmetric_paths {A} : Symmetric (@paths A) | 0 := @inverse A. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Notation "1" := idpath : path_scope. - -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. - -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. - -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) -: f == g - := fun x => match h with idpath => 1 end. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) - }. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) - }. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. -Local Open Scope trunc_scope. -Notation "-2" := minus_two (at level 0) : trunc_scope. -Notation "-1" := (-2.+1) (at level 0) : trunc_scope. -Notation "0" := (-1.+1) : trunc_scope. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | -2 => Contr_internal A - | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Tactic Notation "transparent" "assert" "(" ident(name) ":" constr(type) ")" := - unshelve refine (let __transparent_assert_hypothesis := (_ : type) in _); - [ - | ( - let H := match goal with H := _ |- _ => constr:(H) end in - rename H into name) ]. - -Definition transport_idmap_ap A (P : A -> Type) x y (p : x = y) (u : P x) -: transport P p u = transport idmap (ap P p) u - := match p with idpath => idpath end. - -Section Adjointify. - - Context {A B : Type} (f : A -> B) (g : B -> A). - Context (isretr : Sect g f) (issect : Sect f g). - - Let issect' := fun x => - ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. - - Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). - admit. - Defined. - - Definition isequiv_adjointify : IsEquiv f - := BuildIsEquiv A B f g isretr issect' is_adjoint'. - -End Adjointify. - -Record TruncType (n : trunc_index) := BuildTruncType { - trunctype_type : Type ; - istrunc_trunctype_type : IsTrunc n trunctype_type - }. -Arguments trunctype_type {_} _. - -Coercion trunctype_type : TruncType >-> Sortclass. - -Notation "n -Type" := (TruncType n) (at level 1) : type_scope. -Notation hSet := 0-Type. - -Module Export Category. - Module Export Core. - Set Implicit Arguments. - - Delimit Scope morphism_scope with morphism. - Delimit Scope category_scope with category. - Delimit Scope object_scope with object. - - Record PreCategory := - Build_PreCategory' { - object :> Type; - morphism : object -> object -> Type; - - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g); - - associativity : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - (m3 o m2) o m1 = m3 o (m2 o m1); - - associativity_sym : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - m3 o (m2 o m1) = (m3 o m2) o m1; - - left_identity : forall a b (f : morphism a b), identity b o f = f; - right_identity : forall a b (f : morphism a b), f o identity a = f; - - identity_identity : forall x, identity x o identity x = identity x - }. - Arguments identity {!C%category} / x%object : rename. - Arguments compose {!C%category} / {s d d'}%object (m1 m2)%morphism : rename. - - Definition Build_PreCategory - object morphism compose identity - associativity left_identity right_identity - := @Build_PreCategory' - object - morphism - compose - identity - associativity - (fun _ _ _ _ _ _ _ => symmetry _ _ (associativity _ _ _ _ _ _ _)) - left_identity - right_identity - (fun _ => left_identity _ _ _). - - Module Export CategoryCoreNotations. - Infix "o" := compose : morphism_scope. - Notation "1" := (identity _) : morphism_scope. - End CategoryCoreNotations. - - End Core. - -End Category. -Module Export Core. - Set Implicit Arguments. - - Delimit Scope functor_scope with functor. - - Local Open Scope morphism_scope. - - Section Functor. - Variables C D : PreCategory. - - Record Functor := - { - object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d); - composition_of : forall s d d' - (m1 : morphism C s d) (m2: morphism C d d'), - morphism_of _ _ (m2 o m1) - = (morphism_of _ _ m2) o (morphism_of _ _ m1); - identity_of : forall x, morphism_of _ _ (identity x) - = identity (object_of x) - }. - End Functor. - Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. - -End Core. -Module Export Morphisms. - Set Implicit Arguments. - - Local Open Scope category_scope. - Local Open Scope morphism_scope. - - Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := - { - morphism_inverse : morphism C d s; - left_inverse : morphism_inverse o m = identity _; - right_inverse : m o morphism_inverse = identity _ - }. - - Class Isomorphic {C : PreCategory} s d := - { - morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic - }. - - Coercion morphism_isomorphic : Isomorphic >-> morphism. - - Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. - - Section iso_equiv_relation. - Variable C : PreCategory. - - Global Instance isisomorphism_identity (x : C) : IsIsomorphism (identity x) - := {| morphism_inverse := identity x; - left_inverse := left_identity C x x (identity x); - right_inverse := right_identity C x x (identity x) |}. - - Global Instance isomorphic_refl : Reflexive (@Isomorphic C) - := fun x : C => {| morphism_isomorphic := identity x |}. - - Definition idtoiso (x y : C) (H : x = y) : Isomorphic x y - := match H in (_ = y0) return (x <~=~> y0) with - | 1%path => reflexivity x - end. - End iso_equiv_relation. - -End Morphisms. - -Notation IsCategory C := (forall s d : object C, IsEquiv (@idtoiso C s d)). - -Notation isotoid C s d := (@equiv_inv _ _ (@idtoiso C s d) _). - -Notation cat_of obj := - (@Build_PreCategory obj - (fun x y => x -> y) - (fun _ x => x) - (fun _ _ _ f g => f o g)%core - (fun _ _ _ _ _ _ _ => idpath) - (fun _ _ _ => idpath) - (fun _ _ _ => idpath) - ). -Definition set_cat : PreCategory := cat_of hSet. -Set Implicit Arguments. - -Local Open Scope morphism_scope. - -Section Grothendieck. - Variable C : PreCategory. - Variable F : Functor C set_cat. - - Record Pair := - { - c : C; - x : F c - }. - - Local Notation Gmorphism s d := - { f : morphism C s.(c) d.(c) - | morphism_of F f s.(x) = d.(x) }. - - Definition identity_H s - := apD10 (identity_of F s.(c)) s.(x). - - Definition Gidentity s : Gmorphism s s. - Proof. - exists 1. - apply identity_H. - Defined. - - Definition Gcategory : PreCategory. - Proof. - unshelve refine (@Build_PreCategory - Pair - (fun s d => Gmorphism s d) - Gidentity - _ - _ - _ - _); admit. - Defined. -End Grothendieck. - -Lemma isotoid_1 {C} `{IsCategory C} {x : C} {H : IsIsomorphism (identity x)} -: isotoid C x x {| morphism_isomorphic := (identity x) ; isisomorphism_isomorphic := H |} - = idpath. - admit. -Defined. -Generalizable All Variables. - -Section Grothendieck2. - Context `{IsCategory C}. - Variable F : Functor C set_cat. - - Instance iscategory_grothendieck_toset : IsCategory (Gcategory F). - Proof. - intros s d. - unshelve refine (isequiv_adjointify _ _ _ _). - { - intro m. - transparent assert (H' : (s.(c) = d.(c))). - { - apply (idtoiso C (x := s.(c)) (y := d.(c)))^-1%function. - exists (m : morphism _ _ _).1. - admit. - - } - { - transitivity {| x := transport (fun x => F x) H' s.(x) |}. - admit. - - { - change d with {| c := d.(c) ; x := d.(x) |}; simpl. - apply ap. - subst H'. - simpl. - refine (transport_idmap_ap _ (fun x => F x : Type) _ _ _ _ @ _ @ (m : morphism _ _ _).2). - change (fun x => F x : Type) with (trunctype_type o object_of F)%function. - admit. - } - } - } - { - admit. - } - - { - intro x. - hnf in s, d. - destruct x. - simpl. - erewrite @isotoid_1. diff --git a/test-suite/bugs/closed/4120.v b/test-suite/bugs/closed/4120.v deleted file mode 100644 index 315dc0d242..0000000000 --- a/test-suite/bugs/closed/4120.v +++ /dev/null @@ -1,5 +0,0 @@ -Definition id {T} (x : T) := x. -Goal sigT (fun x => id x)%type. - change (fun x => ?f x) with f. - exists Type. exact Set. -Defined. (* Error: Attempt to save a proof with shelved goals (in proof Unnamed_thm) *) diff --git a/test-suite/bugs/closed/4121.v b/test-suite/bugs/closed/4121.v deleted file mode 100644 index b236846710..0000000000 --- a/test-suite/bugs/closed/4121.v +++ /dev/null @@ -1,18 +0,0 @@ -Unset Strict Universe Declaration. -(* -*- coq-prog-args: ("-nois") -*- *) -(* File reduced by coq-bug-finder from original input, then from 830 lines to 47 lines, then from 25 lines to 11 lines *) -(* coqc version 8.5beta1 (March 2015) compiled on Mar 11 2015 18:51:36 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (8dbfee5c5f897af8186cb1bdfb04fd4f88eca677) *) - -Declare ML Module "ltac_plugin". - -Set Universe Polymorphism. -Class Contr_internal (A : Type) := BuildContr { center : A }. -Arguments center A {_}. -Class Contr (A : Type) : Type := Contr_is_trunc : Contr_internal A. -Hint Extern 0 => progress change Contr_internal with Contr in * : typeclass_instances. -Definition contr_paths_contr0 {A} `{Contr A} : Contr A := {| center := center A |}. -Instance contr_paths_contr1 {A} `{Contr A} : Contr A := {| center := center A |}. -Check @contr_paths_contr0@{i}. -Check @contr_paths_contr1@{i}. (* Error: Universe instance should have length 2 *) -(** It should have length 1, just like contr_paths_contr0 *) diff --git a/test-suite/bugs/closed/4132.v b/test-suite/bugs/closed/4132.v deleted file mode 100644 index 806ffb771f..0000000000 --- a/test-suite/bugs/closed/4132.v +++ /dev/null @@ -1,31 +0,0 @@ - -Require Import ZArith Omega. -Open Scope Z_scope. - -(** bug 4132: omega was using "simpl" either on whole equations, or on - delimited but wrong spots. This was leading to unexpected reductions - when one atom (here [b]) is an evaluable reference instead of a variable. *) - -Lemma foo - (x y x' zxy zxy' z : Z) - (b := 5) - (Ry : - b <= y < b) - (Bx : x' <= b) - (H : - zxy' <= zxy) - (H' : zxy' <= x') : - b <= zxy. -Proof. -omega. (* was: Uncaught exception Invalid_argument("index out of bounds"). *) -Qed. - -Lemma foo2 x y (b := 5) (H1 : x <= y) (H2 : y <= b) : x <= b. -omega. (* Pierre L: according to a comment of bug report #4132, - this might have triggered "index out of bounds" in the past, - but I never managed to reproduce that in any version, - even before my fix. *) -Qed. - -Lemma foo3 x y (b := 0) (H1 : x <= y) (H2 : y <= b) : x <= b. -omega. (* Pierre L: according to a comment of bug report #4132, - this might have triggered "Failure(occurence 2)" in the past, - but I never managed to reproduce that. *) -Qed. diff --git a/test-suite/bugs/closed/4149.v b/test-suite/bugs/closed/4149.v deleted file mode 100644 index b81c680cd7..0000000000 --- a/test-suite/bugs/closed/4149.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal forall A, A -> Type. -Proof. - intros; eauto. -Qed. diff --git a/test-suite/bugs/closed/4151.v b/test-suite/bugs/closed/4151.v deleted file mode 100644 index fc0b58cfe1..0000000000 --- a/test-suite/bugs/closed/4151.v +++ /dev/null @@ -1,403 +0,0 @@ -Lemma foo (H : forall A, A) : forall A, A. - Show Universes. - eexact H. -Qed. - -(* File reduced by coq-bug-finder from original input, then from 6390 lines to 397 lines *) -(* coqc version 8.5beta1 (March 2015) compiled on Mar 17 2015 12:34:25 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (1b3759e78f227eb85a128c58b8ce8c11509dd8c3) *) -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Import Coq.Lists.SetoidList. -Require Export Coq.Program.Program. - -Global Set Implicit Arguments. -Global Set Asymmetric Patterns. - -Fixpoint combine_sig_helper {T} {P : T -> Prop} (ls : list T) : (forall x, In x ls -> P x) -> list (sig P). - admit. -Defined. - -Lemma Forall_forall1_transparent_helper_1 {A P} {x : A} {xs : list A} {l : list A} - (H : Forall P l) (H' : x::xs = l) -: P x. - admit. -Defined. -Lemma Forall_forall1_transparent_helper_2 {A P} {x : A} {xs : list A} {l : list A} - (H : Forall P l) (H' : x::xs = l) -: Forall P xs. - admit. -Defined. - -Fixpoint Forall_forall1_transparent {A} (P : A -> Prop) (l : list A) {struct l} -: Forall P l -> forall x, In x l -> P x - := match l as l return Forall P l -> forall x, In x l -> P x with - | nil => fun _ _ f => match f : False with end - | x::xs => fun H x' H' => - match H' with - | or_introl H'' => eq_rect x - P - (Forall_forall1_transparent_helper_1 H eq_refl) - _ - H'' - | or_intror H'' => @Forall_forall1_transparent A P xs (Forall_forall1_transparent_helper_2 H eq_refl) _ H'' - end - end. - -Definition combine_sig {T P ls} (H : List.Forall P ls) : list (@sig T P) - := combine_sig_helper ls (@Forall_forall1_transparent T P ls H). -Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type - := match ls with - | nil => P nil - | x::xs => (P (x::xs) * Forall_tails P xs)%type - end. - -Record string_like (CharType : Type) := - { - String :> Type; - Singleton : CharType -> String where "[ x ]" := (Singleton x); - Empty : String; - Concat : String -> String -> String where "x ++ y" := (Concat x y); - bool_eq : String -> String -> bool; - bool_eq_correct : forall x y : String, bool_eq x y = true <-> x = y; - Length : String -> nat; - Associativity : forall x y z, (x ++ y) ++ z = x ++ (y ++ z); - LeftId : forall x, Empty ++ x = x; - RightId : forall x, x ++ Empty = x; - Singleton_Length : forall x, Length (Singleton x) = 1; - Length_correct : forall s1 s2, Length s1 + Length s2 = Length (s1 ++ s2); - Length_Empty : Length Empty = 0; - Empty_Length : forall s1, Length s1 = 0 -> s1 = Empty; - Not_Singleton_Empty : forall x, Singleton x <> Empty; - SplitAt : nat -> String -> String * String; - SplitAt_correct : forall n s, fst (SplitAt n s) ++ snd (SplitAt n s) = s; - SplitAt_concat_correct : forall s1 s2, SplitAt (Length s1) (s1 ++ s2) = (s1, s2); - SplitAtLength_correct : forall n s, Length (fst (SplitAt n s)) = min (Length s) n - }. - -Delimit Scope string_like_scope with string_like. -Bind Scope string_like_scope with String. -Arguments Length {_%type_scope _} _%string_like. -Notation "[[ x ]]" := (@Singleton _ _ x) : string_like_scope. -Infix "++" := (@Concat _ _) : string_like_scope. -Infix "=s" := (@bool_eq _ _) (at level 70, right associativity) : string_like_scope. - -Definition str_le {CharType} {String : string_like CharType} (s1 s2 : String) - := Length s1 < Length s2 \/ s1 = s2. -Infix "≤s" := str_le (at level 70, right associativity). - -Record StringWithSplitState {CharType} (String : string_like CharType) (split_stateT : String -> Type) := - { string_val :> String; - state_val : split_stateT string_val }. - -Module Export ContextFreeGrammar. - Require Import Coq.Strings.String. - - Section cfg. - Variable CharType : Type. - - Section definitions. - - Inductive item := - | Terminal (_ : CharType) - | NonTerminal (_ : string). - - Definition production := list item. - Definition productions := list production. - - Record grammar := - { - Start_symbol :> string; - Lookup :> string -> productions; - Start_productions :> productions := Lookup Start_symbol; - Valid_nonterminals : list string; - Valid_productions : list productions := map Lookup Valid_nonterminals - }. - End definitions. - - End cfg. - -End ContextFreeGrammar. -Module Export BaseTypes. - Import Coq.Strings.String. - - Local Open Scope string_like_scope. - - Inductive any_grammar CharType := - | include_item (_ : item CharType) - | include_production (_ : production CharType) - | include_productions (_ : productions CharType) - | include_nonterminal (_ : string). - Global Coercion include_item : item >-> any_grammar. - Global Coercion include_production : production >-> any_grammar. - - Section recursive_descent_parser. - Context {CharType : Type} - {String : string_like CharType} - {G : grammar CharType}. - - Class parser_computational_predataT := - { nonterminals_listT : Type; - initial_nonterminals_data : nonterminals_listT; - is_valid_nonterminal : nonterminals_listT -> string -> bool; - remove_nonterminal : nonterminals_listT -> string -> nonterminals_listT; - nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop; - remove_nonterminal_dec : forall ls nonterminal, - is_valid_nonterminal ls nonterminal = true - -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; - ntl_wf : well_founded nonterminals_listT_R }. - - Class parser_computational_types_dataT := - { predata :> parser_computational_predataT; - split_stateT : String -> nonterminals_listT -> any_grammar CharType -> String -> Type }. - - Class parser_computational_dataT' `{parser_computational_types_dataT} := - { split_string_for_production - : forall (str0 : String) (valid : nonterminals_listT) (it : item CharType) (its : production CharType) (str : StringWithSplitState String (split_stateT str0 valid (it::its : production CharType))), - list (StringWithSplitState String (split_stateT str0 valid it) - * StringWithSplitState String (split_stateT str0 valid its)); - split_string_for_production_correct - : forall str0 valid it its str, - let P f := List.Forall f (@split_string_for_production str0 valid it its str) in - P (fun s1s2 => (fst s1s2 ++ snd s1s2 =s str) = true) }. - End recursive_descent_parser. - -End BaseTypes. -Import Coq.Strings.String. - -Section cfg. - Context CharType (String : string_like CharType) (G : grammar CharType). - Context (names_listT : Type) - (initial_names_data : names_listT) - (is_valid_name : names_listT -> string -> bool) - (remove_name : names_listT -> string -> names_listT) - (names_listT_R : names_listT -> names_listT -> Prop) - (remove_name_dec : forall ls name, - is_valid_name ls name = true - -> names_listT_R (remove_name ls name) ls) - (remove_name_1 - : forall ls ps ps', - is_valid_name (remove_name ls ps) ps' = true - -> is_valid_name ls ps' = true) - (remove_name_2 - : forall ls ps ps', - is_valid_name (remove_name ls ps) ps' = false - <-> is_valid_name ls ps' = false \/ ps = ps') - (ntl_wf : well_founded names_listT_R). - - Inductive minimal_parse_of - : forall (str0 : String) (valid : names_listT) - (str : String), - productions CharType -> Type := - | MinParseHead : forall str0 valid str pat pats, - @minimal_parse_of_production str0 valid str pat - -> @minimal_parse_of str0 valid str (pat::pats) - | MinParseTail : forall str0 valid str pat pats, - @minimal_parse_of str0 valid str pats - -> @minimal_parse_of str0 valid str (pat::pats) - with minimal_parse_of_production - : forall (str0 : String) (valid : names_listT) - (str : String), - production CharType -> Type := - | MinParseProductionNil : forall str0 valid, - @minimal_parse_of_production str0 valid (Empty _) nil - | MinParseProductionCons : forall str0 valid str strs pat pats, - str ++ strs ≤s str0 - -> @minimal_parse_of_item str0 valid str pat - -> @minimal_parse_of_production str0 valid strs pats - -> @minimal_parse_of_production str0 valid (str ++ strs) (pat::pats) - with minimal_parse_of_item - : forall (str0 : String) (valid : names_listT) - (str : String), - item CharType -> Type := - | MinParseTerminal : forall str0 valid x, - @minimal_parse_of_item str0 valid [[ x ]]%string_like (Terminal x) - | MinParseNonTerminal - : forall str0 valid str name, - @minimal_parse_of_name str0 valid str name - -> @minimal_parse_of_item str0 valid str (NonTerminal CharType name) - with minimal_parse_of_name - : forall (str0 : String) (valid : names_listT) - (str : String), - string -> Type := - | MinParseNonTerminalStrLt - : forall str0 valid name str, - Length str < Length str0 - -> is_valid_name initial_names_data name = true - -> @minimal_parse_of str initial_names_data str (Lookup G name) - -> @minimal_parse_of_name str0 valid str name - | MinParseNonTerminalStrEq - : forall str valid name, - is_valid_name initial_names_data name = true - -> is_valid_name valid name = true - -> @minimal_parse_of str (remove_name valid name) str (Lookup G name) - -> @minimal_parse_of_name str valid str name. -End cfg. - -Local Coercion is_true : bool >-> Sortclass. - -Local Open Scope string_like_scope. - -Section general. - Context {CharType} {String : string_like CharType} {G : grammar CharType}. - - Class boolean_parser_dataT := - { predata :> parser_computational_predataT; - split_stateT : String -> Type; - data' :> _ := {| BaseTypes.predata := predata ; BaseTypes.split_stateT := fun _ _ _ => split_stateT |}; - split_string_for_production - : forall it its, - StringWithSplitState String split_stateT - -> list (StringWithSplitState String split_stateT * StringWithSplitState String split_stateT); - split_string_for_production_correct - : forall it its (str : StringWithSplitState String split_stateT), - let P f := List.Forall f (split_string_for_production it its str) in - P (fun s1s2 => - (fst s1s2 ++ snd s1s2 =s str) = true); - premethods :> parser_computational_dataT' - := @Build_parser_computational_dataT' - _ String data' - (fun _ _ => split_string_for_production) - (fun _ _ => split_string_for_production_correct) }. - - Definition split_list_completeT `{data : boolean_parser_dataT} - {str0 valid} - (str : StringWithSplitState String split_stateT) (pf : str ≤s str0) - (split_list : list (StringWithSplitState String split_stateT * StringWithSplitState String split_stateT)) - (it : item CharType) (its : production CharType) - := ({ s1s2 : String * String - & (fst s1s2 ++ snd s1s2 =s str) - * (minimal_parse_of_item _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (fst s1s2) it) - * (minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (snd s1s2) its) }%type) - -> ({ s1s2 : StringWithSplitState String split_stateT * StringWithSplitState String split_stateT - & (In s1s2 split_list) - * (minimal_parse_of_item _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (fst s1s2) it) - * (minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (snd s1s2) its) }%type). -End general. - -Section recursive_descent_parser. - Context {CharType} - {String : string_like CharType} - {G : grammar CharType}. - Context `{data : @boolean_parser_dataT _ String}. - - Section bool. - Section parts. - Definition parse_item - (str_matches_nonterminal : string -> bool) - (str : StringWithSplitState String split_stateT) - (it : item CharType) - : bool - := match it with - | Terminal ch => [[ ch ]] =s str - | NonTerminal nt => str_matches_nonterminal nt - end. - - Section production. - Context {str0} - (parse_nonterminal - : forall (str : StringWithSplitState String split_stateT), - str ≤s str0 - -> string - -> bool). - - Fixpoint parse_production - (str : StringWithSplitState String split_stateT) - (pf : str ≤s str0) - (prod : production CharType) - : bool. - Proof. - refine - match prod with - | nil => - - str =s Empty _ - | it::its - => let parse_production' := fun str pf => parse_production str pf its in - fold_right - orb - false - (let mapF f := map f (combine_sig (split_string_for_production_correct it its str)) in - mapF (fun s1s2p => - (parse_item - (parse_nonterminal (fst (proj1_sig s1s2p)) _) - (fst (proj1_sig s1s2p)) - it) - && parse_production' (snd (proj1_sig s1s2p)) _)%bool) - end; - revert pf; clear; intros; admit. - Defined. - End production. - - End parts. - End bool. -End recursive_descent_parser. - -Section sound. - Context CharType (String : string_like CharType) (G : grammar CharType). - Context `{data : @boolean_parser_dataT CharType String}. - - Section production. - Context (str0 : String) - (parse_nonterminal : forall (str : StringWithSplitState String split_stateT), - str ≤s str0 - -> string - -> bool). - - Definition parse_nonterminal_completeT P - := forall valid (str : StringWithSplitState String split_stateT) pf nonterminal (H_sub : P str0 valid nonterminal), - minimal_parse_of_name _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str nonterminal - -> @parse_nonterminal str pf nonterminal = true. - - Lemma parse_production_complete - valid Pv - (parse_nonterminal_complete : parse_nonterminal_completeT Pv) - (Hinit : forall str (pf : str ≤s str0) nonterminal, - minimal_parse_of_name String G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str nonterminal - -> Pv str0 valid nonterminal) - (str : StringWithSplitState String split_stateT) (pf : str ≤s str0) - (prod : production CharType) - (split_string_for_production_complete' - : forall str0 valid str pf, - Forall_tails - (fun prod' => - match prod' return Type with - | nil => True - | it::its => split_list_completeT (G := G) (valid := valid) (str0 := str0) str pf (split_string_for_production it its str) it its - end) - prod) - : minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str prod - -> parse_production parse_nonterminal str pf prod = true. - admit. - Defined. - End production. - Context (str0 : String) - (parse_nonterminal : forall (str : StringWithSplitState String split_stateT), - str ≤s str0 - -> string - -> bool). - - Goal forall (a : production CharType), - (forall (str1 : String) (valid : nonterminals_listT) - (str : StringWithSplitState String split_stateT) - (pf : str ≤s str1), - Forall_tails - (fun prod' : list (item CharType) => - match prod' with - | [] => True - | it :: its => - split_list_completeT (G := G) (valid := valid) str pf - (split_string_for_production it its str) it its - end) a) -> - forall (str : String) (pf : str ≤s str0) (st : split_stateT str), - parse_production parse_nonterminal - {| string_val := str; state_val := st |} pf a = true. - Proof. - intros a X **. - eapply parse_production_complete. - Focus 3. - exact X. - Undo. - assumption. - Undo. - eassumption. (* no applicable tactic *) diff --git a/test-suite/bugs/closed/4161.v b/test-suite/bugs/closed/4161.v deleted file mode 100644 index d2003ab1f0..0000000000 --- a/test-suite/bugs/closed/4161.v +++ /dev/null @@ -1,27 +0,0 @@ - - (* Inductive t : Type -> Type := *) - (* | Just : forall (A : Type), t A -> t A. *) - - (* Fixpoint test {A : Type} (x : t A) : t (A + unit) := *) - (* match x in t A return t (A + unit) with *) - (* | Just T x => @test T x *) - (* end. *) - - - Definition Type1 := Type. -Definition Type2 := Type. -Definition cast (x:Type2) := x:Type1. -Axiom f: Type2 -> Prop. -Definition A := - let T := fun A:Type1 => _ in - fun A':Type2 => - eq_refl : T A' = f A' :> Prop. -(* Type2 <= Type1... f A -> Type1 <= Type2 *) - -Inductive t : Type -> Type := - | Just : forall (A : Type), t A -> t A. - -Fixpoint test {A : Type} (x : t A) : t (A + unit) := - match x in t A with - | Just B x => @test B x - end. diff --git a/test-suite/bugs/closed/4165.v b/test-suite/bugs/closed/4165.v deleted file mode 100644 index 8e0a62d35c..0000000000 --- a/test-suite/bugs/closed/4165.v +++ /dev/null @@ -1,7 +0,0 @@ -Lemma foo : True. -Proof. -pose (fun x : nat => (let H:=true in x)) as s. -match eval cbv delta [s] in s with -| context C[true] => - let C':=context C[false] in pose C' as s' -end. diff --git a/test-suite/bugs/closed/4187.v b/test-suite/bugs/closed/4187.v deleted file mode 100644 index b13ca36a37..0000000000 --- a/test-suite/bugs/closed/4187.v +++ /dev/null @@ -1,709 +0,0 @@ -(* Lifted from https://coq.inria.fr/bugs/show_bug.cgi?id=4187 *) -(* File reduced by coq-bug-finder from original input, then from 715 lines to 696 lines *) -(* coqc version 8.4pl5 (December 2014) compiled on Dec 28 2014 03:23:16 with OCaml 4.01.0 - coqtop version 8.4pl5 (December 2014) *) -Set Asymmetric Patterns. -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Import Coq.Lists.List. -Require Import Coq.Setoids.Setoid. -Require Import Coq.Numbers.Natural.Peano.NPeano. -Global Set Implicit Arguments. -Global Generalizable All Variables. -Coercion is_true : bool >-> Sortclass. -Coercion bool_of_sumbool {A B} (x : {A} + {B}) : bool := if x then true else false. -Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type - := match ls return Type with - | nil => True - | x::xs => (P x * ForallT P xs)%type - end. -Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type - := match ls with - | nil => P nil - | x::xs => (P (x::xs) * Forall_tails P xs)%type - end. - -Module Export ADTSynthesis_DOT_Common_DOT_Wf. -Module Export ADTSynthesis. -Module Export Common. -Module Export Wf. - -Section wf. - Section wf_prod. - Context A B (RA : relation A) (RB : relation B). -Definition prod_relation : relation (A * B). -exact (fun ab a'b' => - RA (fst ab) (fst a'b') \/ (fst a'b' = fst ab /\ RB (snd ab) (snd a'b'))). -Defined. - - Fixpoint well_founded_prod_relation_helper - a b - (wf_A : Acc RA a) (wf_B : well_founded RB) {struct wf_A} - : Acc prod_relation (a, b) - := match wf_A with - | Acc_intro fa => (fix wf_B_rec b' (wf_B' : Acc RB b') : Acc prod_relation (a, b') - := Acc_intro - _ - (fun ab => - match ab as ab return prod_relation ab (a, b') -> Acc prod_relation ab with - | (a'', b'') => - fun pf => - match pf with - | or_introl pf' - => @well_founded_prod_relation_helper - _ _ - (fa _ pf') - wf_B - | or_intror (conj pfa pfb) - => match wf_B' with - | Acc_intro fb - => eq_rect - _ - (fun a'' => Acc prod_relation (a'', b'')) - (wf_B_rec _ (fb _ pfb)) - _ - pfa - end - end - end) - ) b (wf_B b) - end. - - Definition well_founded_prod_relation : well_founded RA -> well_founded RB -> well_founded prod_relation. - Proof. - intros wf_A wf_B [a b]; hnf in *. - apply well_founded_prod_relation_helper; auto. - Defined. - End wf_prod. - - Section wf_projT1. - Context A (B : A -> Type) (R : relation A). -Definition projT1_relation : relation (sigT B). -exact (fun ab a'b' => - R (projT1 ab) (projT1 a'b')). -Defined. - - Definition well_founded_projT1_relation : well_founded R -> well_founded projT1_relation. - Proof. - intros wf [a b]; hnf in *. - induction (wf a) as [a H IH]. - constructor. - intros y r. - specialize (IH _ r (projT2 y)). - destruct y. - exact IH. - Defined. - End wf_projT1. -End wf. - -Section Fix3. - Context A (B : A -> Type) (C : forall a, B a -> Type) (D : forall a b, C a b -> Type) - (R : A -> A -> Prop) (Rwf : well_founded R) - (P : forall a b c, D a b c -> Type) - (F : forall x : A, (forall y : A, R y x -> forall b c d, P y b c d) -> forall b c d, P x b c d). -Definition Fix3 a b c d : @P a b c d. -exact (@Fix { a : A & { b : B a & { c : C b & D c } } } - (fun x y => R (projT1 x) (projT1 y)) - (well_founded_projT1_relation Rwf) - (fun abcd => P (projT2 (projT2 (projT2 abcd)))) - (fun x f => @F (projT1 x) (fun y r b c d => f (existT _ y (existT _ b (existT _ c d))) r) _ _ _) - (existT _ a (existT _ b (existT _ c d)))). -Defined. -End Fix3. - -End Wf. - -End Common. - -End ADTSynthesis. - -End ADTSynthesis_DOT_Common_DOT_Wf. - -Module Export ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core. -Module Export ADTSynthesis. -Module Export Parsers. -Module Export StringLike. -Module Export Core. -Import Coq.Setoids.Setoid. -Import Coq.Classes.Morphisms. - - - -Module Export StringLike. - Class StringLike {Char : Type} := - { - String :> Type; - is_char : String -> Char -> bool; - length : String -> nat; - take : nat -> String -> String; - drop : nat -> String -> String; - bool_eq : String -> String -> bool; - beq : relation String := fun x y => bool_eq x y - }. - - Arguments StringLike : clear implicits. - Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope. - Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope. - Local Open Scope string_like_scope. - - Definition str_le `{StringLike Char} (s1 s2 : String) - := length s1 < length s2 \/ s1 =s s2. - Infix "≤s" := str_le (at level 70, right associativity). - - Class StringLikeProperties (Char : Type) `{StringLike Char} := - { - singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch'; - length_singleton : forall s ch, s ~= [ ch ] -> length s = 1; - bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s'; - is_char_Proper :> Proper (beq ==> eq ==> eq) is_char; - length_Proper :> Proper (beq ==> eq) length; - take_Proper :> Proper (eq ==> beq ==> beq) take; - drop_Proper :> Proper (eq ==> beq ==> beq) drop; - bool_eq_Equivalence :> Equivalence beq; - bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str'; - take_short_length : forall str n, n <= length str -> length (take n str) = n; - take_long : forall str n, length str <= n -> take n str =s str; - take_take : forall str n m, take n (take m str) =s take (min n m) str; - drop_length : forall str n, length (drop n str) = length str - n; - drop_0 : forall str, drop 0 str =s str; - drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str; - drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str); - take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str) - }. - - Arguments StringLikeProperties Char {_}. -End StringLike. - -End Core. - -End StringLike. - -End Parsers. - -End ADTSynthesis. - -End ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core. - -Module Export ADTSynthesis. -Module Export Parsers. -Module Export ContextFreeGrammar. -Require Import Coq.Strings.String. -Require Import Coq.Lists.List. -Export ADTSynthesis.Parsers.StringLike.Core. -Import ADTSynthesis.Common. - -Local Open Scope string_like_scope. - -Section cfg. - Context {Char : Type}. - - Section definitions. - - Inductive item := - | Terminal (_ : Char) - | NonTerminal (_ : string). - - Definition production := list item. - Definition productions := list production. - - Record grammar := - { - Start_symbol :> string; - Lookup :> string -> productions; - Start_productions :> productions := Lookup Start_symbol; - Valid_nonterminals : list string; - Valid_productions : list productions := map Lookup Valid_nonterminals - }. - End definitions. - - Section parse. - Context {HSL : StringLike Char}. - Variable G : grammar. - - Inductive parse_of (str : String) : productions -> Type := - | ParseHead : forall pat pats, parse_of_production str pat - -> parse_of str (pat::pats) - | ParseTail : forall pat pats, parse_of str pats - -> parse_of str (pat::pats) - with parse_of_production (str : String) : production -> Type := - | ParseProductionNil : length str = 0 -> parse_of_production str nil - | ParseProductionCons : forall n pat pats, - parse_of_item (take n str) pat - -> parse_of_production (drop n str) pats - -> parse_of_production str (pat::pats) - with parse_of_item (str : String) : item -> Type := - | ParseTerminal : forall ch, str ~= [ ch ] -> parse_of_item str (Terminal ch) - | ParseNonTerminal : forall nt, parse_of str (Lookup G nt) - -> parse_of_item str (NonTerminal nt). - End parse. -End cfg. - -Arguments item _ : clear implicits. -Arguments production _ : clear implicits. -Arguments productions _ : clear implicits. -Arguments grammar _ : clear implicits. - -End ContextFreeGrammar. - -Module Export BaseTypes. - -Section recursive_descent_parser. - - Class parser_computational_predataT := - { nonterminals_listT : Type; - initial_nonterminals_data : nonterminals_listT; - is_valid_nonterminal : nonterminals_listT -> String.string -> bool; - remove_nonterminal : nonterminals_listT -> String.string -> nonterminals_listT; - nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop; - remove_nonterminal_dec : forall ls nonterminal, - is_valid_nonterminal ls nonterminal - -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; - ntl_wf : well_founded nonterminals_listT_R }. - - Class parser_removal_dataT' `{predata : parser_computational_predataT} := - { remove_nonterminal_1 - : forall ls ps ps', - is_valid_nonterminal (remove_nonterminal ls ps) ps' - -> is_valid_nonterminal ls ps'; - remove_nonterminal_2 - : forall ls ps ps', - is_valid_nonterminal (remove_nonterminal ls ps) ps' = false - <-> is_valid_nonterminal ls ps' = false \/ ps = ps' }. -End recursive_descent_parser. - -End BaseTypes. -Import Coq.Lists.List. -Import ADTSynthesis.Parsers.ContextFreeGrammar. - -Local Open Scope string_like_scope. - -Section cfg. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - Context {predata : @parser_computational_predataT} - {rdata' : @parser_removal_dataT' predata}. - - Inductive minimal_parse_of - : forall (str0 : String) (valid : nonterminals_listT) - (str : String), - productions Char -> Type := - | MinParseHead : forall str0 valid str pat pats, - @minimal_parse_of_production str0 valid str pat - -> @minimal_parse_of str0 valid str (pat::pats) - | MinParseTail : forall str0 valid str pat pats, - @minimal_parse_of str0 valid str pats - -> @minimal_parse_of str0 valid str (pat::pats) - with minimal_parse_of_production - : forall (str0 : String) (valid : nonterminals_listT) - (str : String), - production Char -> Type := - | MinParseProductionNil : forall str0 valid str, - length str = 0 - -> @minimal_parse_of_production str0 valid str nil - | MinParseProductionCons : forall str0 valid str n pat pats, - str ≤s str0 - -> @minimal_parse_of_item str0 valid (take n str) pat - -> @minimal_parse_of_production str0 valid (drop n str) pats - -> @minimal_parse_of_production str0 valid str (pat::pats) - with minimal_parse_of_item - : forall (str0 : String) (valid : nonterminals_listT) - (str : String), - item Char -> Type := - | MinParseTerminal : forall str0 valid str ch, - str ~= [ ch ] - -> @minimal_parse_of_item str0 valid str (Terminal ch) - | MinParseNonTerminal - : forall str0 valid str (nt : String.string), - @minimal_parse_of_nonterminal str0 valid str nt - -> @minimal_parse_of_item str0 valid str (NonTerminal nt) - with minimal_parse_of_nonterminal - : forall (str0 : String) (valid : nonterminals_listT) - (str : String), - String.string -> Type := - | MinParseNonTerminalStrLt - : forall str0 valid (nt : String.string) str, - length str < length str0 - -> is_valid_nonterminal initial_nonterminals_data nt - -> @minimal_parse_of str initial_nonterminals_data str (Lookup G nt) - -> @minimal_parse_of_nonterminal str0 valid str nt - | MinParseNonTerminalStrEq - : forall str0 str valid nonterminal, - str =s str0 - -> is_valid_nonterminal initial_nonterminals_data nonterminal - -> is_valid_nonterminal valid nonterminal - -> @minimal_parse_of str0 (remove_nonterminal valid nonterminal) str (Lookup G nonterminal) - -> @minimal_parse_of_nonterminal str0 valid str nonterminal. -End cfg. -Import ADTSynthesis.Common. - -Section general. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - - Class boolean_parser_dataT := - { predata :> parser_computational_predataT; - split_string_for_production - : item Char -> production Char -> String -> list nat }. - - Global Coercion predata : boolean_parser_dataT >-> parser_computational_predataT. - - Definition split_list_completeT `{data : @parser_computational_predataT} - {str0 valid} - (it : item Char) (its : production Char) - (str : String) - (pf : str ≤s str0) - (split_list : list nat) - - := ({ n : nat - & (minimal_parse_of_item (G := G) (predata := data) str0 valid (take n str) it) - * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type) - -> ({ n : nat - & (In n split_list) - * (minimal_parse_of_item (G := G) str0 valid (take n str) it) - * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type). - - Class boolean_parser_completeness_dataT' `{data : boolean_parser_dataT} := - { split_string_for_production_complete - : forall str0 valid str (pf : str ≤s str0) nt, - is_valid_nonterminal initial_nonterminals_data nt - -> ForallT - (Forall_tails - (fun prod - => match prod return Type with - | nil => True - | it::its - => @split_list_completeT data str0 valid it its str pf (split_string_for_production it its str) - end)) - (Lookup G nt) }. -End general. - -Module Export BooleanRecognizer. -Import Coq.Numbers.Natural.Peano.NPeano. -Import Coq.Arith.Compare_dec. -Import Coq.Arith.Wf_nat. - -Section recursive_descent_parser. - Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} {G : grammar Char}. - Context {data : @boolean_parser_dataT Char _}. - - Section bool. - Section parts. -Definition parse_item - (str_matches_nonterminal : String.string -> bool) - (str : String) - (it : item Char) - : bool. -Admitted. - - Section production. - Context {str0} - (parse_nonterminal - : forall (str : String), - str ≤s str0 - -> String.string - -> bool). - - Fixpoint parse_production - (str : String) - (pf : str ≤s str0) - (prod : production Char) - : bool. - Proof. - refine - match prod with - | nil => - - Nat.eq_dec (length str) 0 - | it::its - => let parse_production' := fun str pf => parse_production str pf its in - fold_right - orb - false - (map (fun n => - (parse_item - (parse_nonterminal (str := take n str) _) - (take n str) - it) - && parse_production' (drop n str) _)%bool - (split_string_for_production it its str)) - end; - revert pf; clear -HSLP; intros; admit. - Defined. - End production. - - Section productions. - Context {str0} - (parse_nonterminal - : forall (str : String) - (pf : str ≤s str0), - String.string -> bool). -Definition parse_productions - (str : String) - (pf : str ≤s str0) - (prods : productions Char) - : bool. -exact (fold_right orb - false - (map (parse_production parse_nonterminal pf) - prods)). -Defined. - End productions. - - Section nonterminals. - Section step. - Context {str0 valid} - (parse_nonterminal - : forall (p : String * nonterminals_listT), - prod_relation (ltof _ length) nonterminals_listT_R p (str0, valid) - -> forall str : String, - str ≤s fst p -> String.string -> bool). - - Definition parse_nonterminal_step - (str : String) - (pf : str ≤s str0) - (nt : String.string) - : bool. - Proof. - refine - (if lt_dec (length str) (length str0) - then - parse_productions - (@parse_nonterminal - (str : String, initial_nonterminals_data) - (or_introl _)) - (or_intror (reflexivity _)) - (Lookup G nt) - else - if Sumbool.sumbool_of_bool (is_valid_nonterminal valid nt) - then - parse_productions - (@parse_nonterminal - (str0 : String, remove_nonterminal valid nt) - (or_intror (conj eq_refl (remove_nonterminal_dec _ nt _)))) - (str := str) - _ - (Lookup G nt) - else - false); - assumption. - Defined. - End step. - - Section wf. -Definition parse_nonterminal_or_abort - : forall (p : String * nonterminals_listT) - (str : String), - str ≤s fst p - -> String.string - -> bool. -exact (Fix3 - _ _ _ - (well_founded_prod_relation - (well_founded_ltof _ length) - ntl_wf) - _ - (fun sl => @parse_nonterminal_step (fst sl) (snd sl))). -Defined. -Definition parse_nonterminal - (str : String) - (nt : String.string) - : bool. -exact (@parse_nonterminal_or_abort - (str : String, initial_nonterminals_data) str - (or_intror (reflexivity _)) nt). -Defined. - End wf. - End nonterminals. - End parts. - End bool. -End recursive_descent_parser. - -Section cfg. - Context {Char} {HSL : StringLike Char} {HSLP : @StringLikeProperties Char HSL} (G : grammar Char). - - Section definitions. - Context (P : String -> String.string -> Type). - - Definition Forall_parse_of_item' - (Forall_parse_of : forall {str pats} (p : parse_of G str pats), Type) - {str it} (p : parse_of_item G str it) - := match p return Type with - | ParseTerminal ch pf => unit - | ParseNonTerminal nt p' - => (P str nt * Forall_parse_of p')%type - end. - - Fixpoint Forall_parse_of {str pats} (p : parse_of G str pats) - := match p with - | ParseHead pat pats p' - => Forall_parse_of_production p' - | ParseTail _ _ p' - => Forall_parse_of p' - end - with Forall_parse_of_production {str pat} (p : parse_of_production G str pat) - := match p return Type with - | ParseProductionNil pf => unit - | ParseProductionCons pat strs pats p' p'' - => (Forall_parse_of_item' (@Forall_parse_of) p' * Forall_parse_of_production p'')%type - end. - - Definition Forall_parse_of_item {str it} (p : parse_of_item G str it) - := @Forall_parse_of_item' (@Forall_parse_of) str it p. - End definitions. - - End cfg. - -Section recursive_descent_parser_list. - Context {Char} {HSL : StringLike Char} {HLSP : StringLikeProperties Char} {G : grammar Char}. -Definition rdp_list_nonterminals_listT : Type. -exact (list String.string). -Defined. -Definition rdp_list_is_valid_nonterminal : rdp_list_nonterminals_listT -> String.string -> bool. -admit. -Defined. -Definition rdp_list_remove_nonterminal : rdp_list_nonterminals_listT -> String.string -> rdp_list_nonterminals_listT. -admit. -Defined. -Definition rdp_list_nonterminals_listT_R : rdp_list_nonterminals_listT -> rdp_list_nonterminals_listT -> Prop. -exact (ltof _ (@List.length _)). -Defined. - Lemma rdp_list_remove_nonterminal_dec : forall ls prods, - @rdp_list_is_valid_nonterminal ls prods = true - -> @rdp_list_nonterminals_listT_R (@rdp_list_remove_nonterminal ls prods) ls. -admit. -Defined. - Lemma rdp_list_ntl_wf : well_founded rdp_list_nonterminals_listT_R. - Proof. - unfold rdp_list_nonterminals_listT_R. - intro. - apply well_founded_ltof. - Defined. - - Global Instance rdp_list_predata : parser_computational_predataT - := { nonterminals_listT := rdp_list_nonterminals_listT; - initial_nonterminals_data := Valid_nonterminals G; - is_valid_nonterminal := rdp_list_is_valid_nonterminal; - remove_nonterminal := rdp_list_remove_nonterminal; - nonterminals_listT_R := rdp_list_nonterminals_listT_R; - remove_nonterminal_dec := rdp_list_remove_nonterminal_dec; - ntl_wf := rdp_list_ntl_wf }. -End recursive_descent_parser_list. - -Section sound. - Section general. - Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char). - Context {data : @boolean_parser_dataT Char _} - {cdata : @boolean_parser_completeness_dataT' Char _ G data} - {rdata : @parser_removal_dataT' predata}. - - Section parts. - - Section nonterminals. - Section wf. - - Lemma parse_nonterminal_sound - (str : String) (nonterminal : String.string) - : parse_nonterminal (G := G) str nonterminal - = true - -> parse_of_item G str (NonTerminal nonterminal). -admit. -Defined. - End wf. - End nonterminals. - End parts. - End general. -End sound. - -Import Coq.Strings.String. -Import ADTSynthesis.Parsers.ContextFreeGrammar. - -Fixpoint list_to_productions {T} (default : T) (ls : list (string * T)) : string -> T - := match ls with - | nil => fun _ => default - | (str, t)::ls' => fun s => if string_dec str s - then t - else list_to_productions default ls' s - end. - -Fixpoint list_to_grammar {T} (default : productions T) (ls : list (string * productions T)) : grammar T - := {| Start_symbol := hd ""%string (map (@fst _ _) ls); - Lookup := list_to_productions default ls; - Valid_nonterminals := map (@fst _ _) ls |}. - -Section interface. - Context {Char} (G : grammar Char). -Definition production_is_reachable (p : production Char) : Prop. -admit. -Defined. -Definition split_list_is_complete `{HSL : StringLike Char} (str : String) (it : item Char) (its : production Char) - (splits : list nat) - : Prop. -exact (forall n, - n <= length str - -> parse_of_item G (take n str) it - -> parse_of_production G (drop n str) its - -> production_is_reachable (it::its) - -> List.In n splits). -Defined. - - Record Splitter := - { - string_type :> StringLike Char; - splits_for : String -> item Char -> production Char -> list nat; - - string_type_properties :> StringLikeProperties Char; - splits_for_complete : forall str it its, - split_list_is_complete str it its (splits_for str it its) - - }. - Global Existing Instance string_type_properties. - - Record Parser (HSL : StringLike Char) := - { - has_parse : @String Char HSL -> bool; - - has_parse_sound : forall str, - has_parse str = true - -> parse_of_item G str (NonTerminal (Start_symbol G)); - - has_parse_complete : forall str (p : parse_of_item G str (NonTerminal (Start_symbol G))), - Forall_parse_of_item - (fun _ nt => List.In nt (Valid_nonterminals G)) - p - -> has_parse str = true - }. -End interface. - -Module Export ParserImplementation. - -Section implementation. - Context {Char} {G : grammar Char}. - Context (splitter : Splitter G). - - Local Instance parser_data : @boolean_parser_dataT Char _ := - { predata := rdp_list_predata (G := G); - split_string_for_production it its str - := splits_for splitter str it its }. - - Program Definition parser : Parser G splitter - := {| has_parse str := parse_nonterminal (G := G) (data := parser_data) str (Start_symbol G); - has_parse_sound str Hparse := parse_nonterminal_sound G _ _ Hparse; - has_parse_complete str p Hp := _ |}. - Next Obligation. -admit. -Defined. -End implementation. - -End ParserImplementation. - -Section implementation. - Context {Char} {ls : list (String.string * productions Char)}. - Local Notation G := (list_to_grammar (nil::nil) ls) (only parsing). - Context (splitter : Splitter G). - - Local Instance parser_data : @boolean_parser_dataT Char _ := parser_data splitter. - - Goal forall str : @String Char splitter, - let G' := - @BooleanRecognizer.parse_nonterminal Char splitter splitter G parser_data str G = true in - G'. - intros str G'. - Timeout 1 assert (pf' : G' -> Prop) by abstract admit. diff --git a/test-suite/bugs/closed/4190.v b/test-suite/bugs/closed/4190.v deleted file mode 100644 index 2843488ba0..0000000000 --- a/test-suite/bugs/closed/4190.v +++ /dev/null @@ -1,15 +0,0 @@ -Module Type A . - Tactic Notation "bar" := idtac "ITSME". -End A. - -Module Type B. - Tactic Notation "foo" := fail "NOTME". -End B. - -Module Type C := A <+ B. - -Module Type F (Import M : C). - -Lemma foo : True. -Proof. -bar. diff --git a/test-suite/bugs/closed/4191.v b/test-suite/bugs/closed/4191.v deleted file mode 100644 index 290bb384d9..0000000000 --- a/test-suite/bugs/closed/4191.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Test maximal implicit arguments in the presence of let-ins *) -Definition foo (x := 1) {y : nat} (H : y = y) : True := I. -Definition bar {y : nat} (x := 1) (H : y = y) : True := I. -Check bar (eq_refl 1). -Check foo (eq_refl 1). diff --git a/test-suite/bugs/closed/4193.v b/test-suite/bugs/closed/4193.v deleted file mode 100644 index 885d04a927..0000000000 --- a/test-suite/bugs/closed/4193.v +++ /dev/null @@ -1,7 +0,0 @@ -Module Type E. -End E. - -Module Type A (M : E). -End A. - -Fail Module Type F (Import X : A). diff --git a/test-suite/bugs/closed/4198.v b/test-suite/bugs/closed/4198.v deleted file mode 100644 index 28800ac05a..0000000000 --- a/test-suite/bugs/closed/4198.v +++ /dev/null @@ -1,39 +0,0 @@ -(* Check that the subterms of the predicate of a match are taken into account *) - -Require Import List. -Open Scope list_scope. -Goal forall A (x x' : A) (xs xs' : list A) (H : x::xs = x'::xs'), - let k := - (match H in (_ = y) return x = hd x y with - | eq_refl => eq_refl - end : x = x') - in k = k. - simpl. - intros. - match goal with - | [ |- context G[@hd] ] => idtac - end. -Abort. - -(* This second example comes from CFGV where inspecting subterms of a - match is expecting to inspect first the term to match (even though - it would certainly be better to provide a "match x with _ end" - construct for generically matching a "match") *) - -Ltac find_head_of_head_match T := - match T with context [?E] => - match T with - | E => fail 1 - | _ => constr:(E) - end - end. - -Ltac mydestruct := - match goal with - | |- ?T1 = _ => let E := find_head_of_head_match T1 in destruct E - end. - -Goal forall x, match x with 0 => 0 | _ => 0 end = 0. -intros. -mydestruct. -Abort. diff --git a/test-suite/bugs/closed/4202.v b/test-suite/bugs/closed/4202.v deleted file mode 100644 index 522a3604a3..0000000000 --- a/test-suite/bugs/closed/4202.v +++ /dev/null @@ -1,10 +0,0 @@ -Parameter g : nat -> Prop. -Axiom a : forall n, g (S n). -Lemma foo (H : True) : exists n, g n /\ g n. -eexists. -clear H. -split. -simple apply a. -(* goal is "g (S ?Goal0@ {H:=H})" while H has long ceased to exist *) -simpl. -Abort. diff --git a/test-suite/bugs/closed/4203.v b/test-suite/bugs/closed/4203.v deleted file mode 100644 index eb6867a033..0000000000 --- a/test-suite/bugs/closed/4203.v +++ /dev/null @@ -1,19 +0,0 @@ -Set Primitive Projections. - -Record ops {T:Type} := { is_ok : T -> Prop; constant : T }. -Arguments ops : clear implicits. - -Record ops_ok {T} (Ops:ops T) := { constant_ok : is_ok Ops (constant Ops) }. - -Definition nat_ops : ops nat := {| is_ok := fun n => n = 1; constant := 1 |}. -Definition nat_ops_ok : ops_ok nat_ops. -Proof. - split. cbn. apply eq_refl. -Qed. - -Definition t := Eval lazy in constant_ok nat_ops nat_ops_ok. -Definition t' := Eval vm_compute in constant_ok nat_ops nat_ops_ok. -Definition t'' := Eval native_compute in constant_ok nat_ops nat_ops_ok. - -Check (eq_refl t : t = t'). -Check (eq_refl t : t = t''). diff --git a/test-suite/bugs/closed/4205.v b/test-suite/bugs/closed/4205.v deleted file mode 100644 index c40dfcc1f3..0000000000 --- a/test-suite/bugs/closed/4205.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Testing a regression from 8.5beta1 to 8.5beta2 in evar-evar tactic unification problems *) - - -Inductive test : nat -> nat -> nat -> nat -> Prop := - | test1 : forall m n, test m n m n. - -Goal test 1 2 3 4. -erewrite f_equal2 with (f := fun k l => test _ _ k l). diff --git a/test-suite/bugs/closed/4214.v b/test-suite/bugs/closed/4214.v deleted file mode 100644 index 2e620fce2a..0000000000 --- a/test-suite/bugs/closed/4214.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Check that subst uses all equations around *) -Goal forall A (a b c : A), b = a -> b = c -> a = c. -intros. -subst. -reflexivity. -Qed. diff --git a/test-suite/bugs/closed/4216.v b/test-suite/bugs/closed/4216.v deleted file mode 100644 index ae7f746778..0000000000 --- a/test-suite/bugs/closed/4216.v +++ /dev/null @@ -1,20 +0,0 @@ -Generalizable Variables T A. - -Inductive path `(a: A): A -> Type := idpath: path a a. - -Class TMonad (T: Type -> Type) := { - bind: forall {A B: Type}, (T A) -> (A -> T B) -> T B; - ret: forall {A: Type}, A -> T A; - ret_unit_left: forall {A B: Type} (k: A -> T B) (a: A), - path (bind (ret a) k) (k a) - }. - -Let T_fzip `{TMonad T} := fun (A B: Type) (f: T (A -> B)) (t: T A) - => bind t (fun a => bind f (fun g => ret (g a) )). -Let T_pure `{TMonad T} := @ret _ _. - -Let T_pure_id `{TMonad T} {A: Type} (t: A -> A) (x: T A): - path (T_fzip A A (T_pure (A -> A) t) x) x. - unfold T_fzip, T_pure. - Fail rewrite (ret_unit_left (fun g a => ret (g a)) (fun x => x)). - diff --git a/test-suite/bugs/closed/4217.v b/test-suite/bugs/closed/4217.v deleted file mode 100644 index 19973f30a7..0000000000 --- a/test-suite/bugs/closed/4217.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Checking correct index of implicit by pos in fixpoints *) - -Fixpoint ith_default - {default_A : nat} - {As : list nat} - {struct As} : Set. diff --git a/test-suite/bugs/closed/4221.v b/test-suite/bugs/closed/4221.v deleted file mode 100644 index bc120fb1ff..0000000000 --- a/test-suite/bugs/closed/4221.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Some test checking that interpreting binder names using ltac - context does not accidentally break the bindings *) - -Goal (forall x : nat, x = 1 -> False) -> 1 = 1 -> False. - intros H0 x. - lazymatch goal with - | [ x : forall k : nat, _ |- _ ] - => specialize (fun H0 => x 1 H0) - end. diff --git a/test-suite/bugs/closed/4232.v b/test-suite/bugs/closed/4232.v deleted file mode 100644 index 61e544a914..0000000000 --- a/test-suite/bugs/closed/4232.v +++ /dev/null @@ -1,20 +0,0 @@ -Require Import Setoid Morphisms Vector. - -Class Equiv A := equiv : A -> A -> Prop. -Class Setoid A `{Equiv A} := setoid_equiv:> Equivalence (equiv). - -Global Declare Instance vec_equiv {A} `{Equiv A} {n}: Equiv (Vector.t A n). -Global Declare Instance vec_setoid A `{Setoid A} n : Setoid (Vector.t A n). - -Global Declare Instance tl_proper1 {A} `{Equiv A} n: - Proper ((equiv) ==> (equiv)) - (@tl A n). - -Lemma test: - forall {A} `{Setoid A} n (xa ya: Vector.t A (S n)), - (equiv xa ya) -> equiv (tl xa) (tl ya). -Proof. - intros A R HA n xa ya Heq. - setoid_rewrite Heq. - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/4234.v b/test-suite/bugs/closed/4234.v deleted file mode 100644 index 348dd49d93..0000000000 --- a/test-suite/bugs/closed/4234.v +++ /dev/null @@ -1,7 +0,0 @@ -Definition UU := Type. - -Definition dirprodpair {X Y : UU} := existT (fun x : X => Y). - -Definition funtoprodtoprod {X Y Z : UU} : { a : X -> Y & X -> Z }. -Proof. - refine (dirprodpair _ (fun x => _)). diff --git a/test-suite/bugs/closed/4240.v b/test-suite/bugs/closed/4240.v deleted file mode 100644 index 083c59fe68..0000000000 --- a/test-suite/bugs/closed/4240.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Check that closure of filter did not restrict the former evar filter *) - -Lemma foo (new : nat) : False. -evar (H1: nat). -set (H3 := 0). -assert (H3' := id H3). -evar (H5: nat). -clear H3. -assert (H5 = new). -unfold H5. -unfold H1. -exact (eq_refl new). diff --git a/test-suite/bugs/closed/4250.v b/test-suite/bugs/closed/4250.v deleted file mode 100644 index f5d0d1a523..0000000000 --- a/test-suite/bugs/closed/4250.v +++ /dev/null @@ -1,11 +0,0 @@ -Require Import FunInd. -Require Vector. -Generalizable All Variables. - -Definition f `{n:nat , u:Vector.t A n} := n. - -Function f2 {A:Type} {n:nat} {v:Vector.t A n} : nat := n. - -(* fails with "The reference A was not found in the current environment." *) -Function f3 `{n:nat , u:Vector.t A n} := u. -Check R_f3_complete. diff --git a/test-suite/bugs/closed/4251.v b/test-suite/bugs/closed/4251.v deleted file mode 100644 index f112e7b4d5..0000000000 --- a/test-suite/bugs/closed/4251.v +++ /dev/null @@ -1,17 +0,0 @@ - -Inductive array : Type -> Type := -| carray : forall A, array A. - -Inductive Mtac : Type -> Prop := -| bind : forall {A B}, Mtac A -> (A -> Mtac B) -> Mtac B -| array_make : forall {A}, A -> Mtac (array A). - -Definition Ref := array. - -Definition ref : forall {A}, A -> Mtac (Ref A) := - fun A x=> array_make x. -Check array Type. -Check fun A : Type => Ref A. - -Definition abs_val (a : Type) := - bind (ref a) (fun r : array Type => array_make tt). diff --git a/test-suite/bugs/closed/4254.v b/test-suite/bugs/closed/4254.v deleted file mode 100644 index ef219973df..0000000000 --- a/test-suite/bugs/closed/4254.v +++ /dev/null @@ -1,13 +0,0 @@ -Inductive foo (V:Type):Type := - | Foo : list (bar V) -> foo V -with bar (V:Type): Type := - | bar1: bar V - | bar2 : V -> bar V. - -Module WithPoly. -Polymorphic Inductive foo (V:Type):Type := - | Foo : list (bar V) -> foo V -with bar (V:Type): Type := - | bar1: bar V - | bar2 : V -> bar V. -End WithPoly. diff --git a/test-suite/bugs/closed/4256.v b/test-suite/bugs/closed/4256.v deleted file mode 100644 index 3cdc4ada02..0000000000 --- a/test-suite/bugs/closed/4256.v +++ /dev/null @@ -1,43 +0,0 @@ -(* Testing 8.5 regression with type classes not solving evars - redefined while trying to solve them with the type class mechanism *) - -Global Set Universe Polymorphism. -Monomorphic Universe i. -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. -Notation "-1" := (trunc_S minus_two) (at level 0). - -Class IsPointed (A : Type) := point : A. -Arguments point A {_}. - -Record pType := - { pointed_type : Type ; - ispointed_type : IsPointed pointed_type }. -Coercion pointed_type : pType >-> Sortclass. -Existing Instance ispointed_type. - -Private Inductive Trunc (n : trunc_index) (A :Type) : Type := - tr : A -> Trunc n A. -Arguments tr {n A} a. - - - -Record ooGroup := - { classifying_space : pType@{i} }. - -Definition group_loops (X : pType) -: ooGroup. -Proof. - (** This works: *) - pose (x0 := point X). - pose (H := existT (fun x:X => Trunc -1 (x = point X)) x0 (tr idpath)). - clear H x0. - (** But this doesn't: *) - pose (existT (fun x:X => Trunc -1 (x = point X)) (point X) (tr idpath)). diff --git a/test-suite/bugs/closed/4272.v b/test-suite/bugs/closed/4272.v deleted file mode 100644 index aeb4c9bb95..0000000000 --- a/test-suite/bugs/closed/4272.v +++ /dev/null @@ -1,12 +0,0 @@ -Set Implicit Arguments. - -Record foo := Foo { p1 : Type; p2 : p1 }. - -Variable x : foo. - -Let p := match x with @Foo a b => a end. - -Notation "@ 'id'" := 3 (at level 10). -Notation "@ 'sval'" := 3 (at level 10). - -Let q := match x with @Foo a b => a end. diff --git a/test-suite/bugs/closed/4273.v b/test-suite/bugs/closed/4273.v deleted file mode 100644 index 401e86649b..0000000000 --- a/test-suite/bugs/closed/4273.v +++ /dev/null @@ -1,9 +0,0 @@ - - -Set Primitive Projections. -Record total2 (P : nat -> Prop) := tpair { pr1 : nat; pr2 : P pr1 }. -Theorem onefiber' (q : total2 (fun y => y = 0)) : True. -Proof. assert (foo:=pr2 _ q). simpl in foo. - destruct foo. (* Error: q is used in conclusion. *) exact I. Qed. - -Print onefiber'. diff --git a/test-suite/bugs/closed/4276.v b/test-suite/bugs/closed/4276.v deleted file mode 100644 index ea9cbb210f..0000000000 --- a/test-suite/bugs/closed/4276.v +++ /dev/null @@ -1,11 +0,0 @@ -Set Primitive Projections. - -Record box (T U : Type) (x := T) := wrap { unwrap : T }. -Definition mybox : box True False := wrap _ _ I. -Definition unwrap' := @unwrap. - -Definition bad' : True := mybox.(unwrap _ _). - -Fail Definition bad : False := unwrap _ _ mybox. - -(* Closed under the global context *) diff --git a/test-suite/bugs/closed/4280.v b/test-suite/bugs/closed/4280.v deleted file mode 100644 index fd7897509e..0000000000 --- a/test-suite/bugs/closed/4280.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Import ZArith. -Require Import Eqdep_dec. -Local Open Scope Z_scope. - -Definition t := { n: Z | n > 1 }. - -Program Definition two : t := 2. -Next Obligation. omega. Qed. - -Program Definition t_eq (x y: t) : {x=y} + {x<>y} := - if Z.eq_dec (proj1_sig x) (proj1_sig y) then left _ else right _. -Next Obligation. - destruct x as [x Px], y as [y Py]. simpl in H; subst y. - f_equal. apply UIP_dec. decide equality. -Qed. -Next Obligation. - congruence. -Qed. - -Definition t_list_eq: forall (x y: list t), {x=y} + {x<>y}. -Proof. decide equality. apply t_eq. Defined. - -Goal match t_list_eq (two::nil) (two::nil) with left _ => True | right _ => False end. -Proof. exact I. Qed. diff --git a/test-suite/bugs/closed/4283.v b/test-suite/bugs/closed/4283.v deleted file mode 100644 index e06998b711..0000000000 --- a/test-suite/bugs/closed/4283.v +++ /dev/null @@ -1,8 +0,0 @@ -Require Import Hurkens. - -Polymorphic Record box (X : Type) (T := Type) : Type := wrap { unwrap : T }. - -Definition unwrap' := fun (X : Type) (b : box X) => let (unwrap) := b in unwrap. - -Fail Definition bad : False := TypeNeqSmallType.paradox (unwrap' Type (wrap _ Type)) eq_refl. - diff --git a/test-suite/bugs/closed/4284.v b/test-suite/bugs/closed/4284.v deleted file mode 100644 index 0fff3026ff..0000000000 --- a/test-suite/bugs/closed/4284.v +++ /dev/null @@ -1,6 +0,0 @@ -Set Primitive Projections. -Record total2 { T: Type } ( P: T -> Type ) := tpair { pr1 : T; pr2 : P pr1 }. -Theorem onefiber' {X : Type} (P : X -> Type) (x : X) : True. -Proof. -set (Q1 := total2 (fun f => pr1 P f = x)). -set (f1:=fun q1 : Q1 => pr2 _ (pr1 _ q1)). diff --git a/test-suite/bugs/closed/4287.v b/test-suite/bugs/closed/4287.v deleted file mode 100644 index 757b71b2dd..0000000000 --- a/test-suite/bugs/closed/4287.v +++ /dev/null @@ -1,123 +0,0 @@ -Unset Strict Universe Declaration. - -Universe b. - -Universe c. - -Definition U : Type@{b} := Type@{c}. - -Module Type MT. - -Definition T := Prop. -End MT. - -Module M : MT. - Definition T := Type@{b}. - -Print Universes. -Fail End M. - -Set Universe Polymorphism. - -(* This is a modified version of Hurkens with all universes floating *) -Section Hurkens. - -Variable down : Type -> Type. -Variable up : Type -> Type. - -Hypothesis back : forall A, up (down A) -> A. - -Hypothesis forth : forall A, A -> up (down A). - -Hypothesis backforth : forall (A:Type) (P:A->Type) (a:A), - P (back A (forth A a)) -> P a. - -Hypothesis backforth_r : forall (A:Type) (P:A->Type) (a:A), - P a -> P (back A (forth A a)). - -(** Proof *) -Definition V : Type := forall A:Type, ((up A -> Type) -> up A -> Type) -> up A -> Type. -Definition U : Type := V -> Type. - -Definition sb (z:V) : V := fun A r a => r (z A r) a. -Definition le (i:U -> Type) (x:U) : Type := x (fun A r a => i (fun v => sb v A r a)). -Definition le' (i:up (down U) -> Type) (x:up (down U)) : Type := le (fun a:U => i (forth _ a)) (back _ x). -Definition induct (i:U -> Type) : Type := forall x:U, up (le i x) -> up (i x). -Definition WF : U := fun z => down (induct (fun a => z (down U) le' (forth _ a))). -Definition I (x:U) : Type := - (forall i:U -> Type, up (le i x) -> up (i (fun v => sb v (down U) le' (forth _ x)))) -> False. - -Lemma Omega : forall i:U -> Type, induct i -> up (i WF). -Proof. -intros i y. -apply y. -unfold le, WF, induct. -apply forth. -intros x H0. -apply y. -unfold sb, le', le. -compute. -apply backforth_r. -exact H0. -Qed. - -Lemma lemma1 : induct (fun u => down (I u)). -Proof. -unfold induct. -intros x p. -apply forth. -intro q. -generalize (q (fun u => down (I u)) p). -intro r. -apply back in r. -apply r. -intros i j. -unfold le, sb, le', le in j |-. -apply backforth in j. -specialize q with (i := fun y => i (fun v:V => sb v (down U) le' (forth _ y))). -apply q. -exact j. -Qed. - -Lemma lemma2 : (forall i:U -> Type, induct i -> up (i WF)) -> False. -Proof. -intro x. -generalize (x (fun u => down (I u)) lemma1). -intro r; apply back in r. -apply r. -intros i H0. -apply (x (fun y => i (fun v => sb v (down U) le' (forth _ y)))). -unfold le, WF in H0. -apply back in H0. -exact H0. -Qed. - -Theorem paradox : False. -Proof. -exact (lemma2 Omega). -Qed. - -End Hurkens. - -Polymorphic Record box (T : Type) := wrap {unwrap : T}. - -(* Here we instantiate to Set *) - -Fail Definition down (x : Type) : Prop := box x. -Definition up (x : Prop) : Type := x. - -Fail Definition back A : up (down A) -> A := unwrap A. - -Fail Definition forth A : A -> up (down A) := wrap A. - -Definition id {A : Type} (a : A) := a. -Definition setlt (A : Type@{i}) := - let foo := Type@{i} : Type@{j} in True. - -Definition setle (B : Type@{i}) := - let foo (A : Type@{j}) := A in foo B. - -Fail Check @setlt@{j Prop}. -Fail Definition foo := @setle@{j Prop}. -Check setlt@{Set i}. -Check setlt@{Set j}. diff --git a/test-suite/bugs/closed/4292.v b/test-suite/bugs/closed/4292.v deleted file mode 100644 index 403e155eaf..0000000000 --- a/test-suite/bugs/closed/4292.v +++ /dev/null @@ -1,7 +0,0 @@ -Module Type S. End S. - -Declare Module M : S. - -Module Type F (T: S). End F. - -Fail Module Type N := F with Module T := M. diff --git a/test-suite/bugs/closed/4293.v b/test-suite/bugs/closed/4293.v deleted file mode 100644 index 21d333fa63..0000000000 --- a/test-suite/bugs/closed/4293.v +++ /dev/null @@ -1,7 +0,0 @@ -Module Type Foo. -Definition T := let X := Type in Type. -End Foo. - -Module M : Foo. -Definition T := let X := Type in Type. -End M. diff --git a/test-suite/bugs/closed/4294.v b/test-suite/bugs/closed/4294.v deleted file mode 100644 index 1d5e3c71b8..0000000000 --- a/test-suite/bugs/closed/4294.v +++ /dev/null @@ -1,31 +0,0 @@ -Require Import Hurkens. - -Module NonPoly. -Module Type Foo. - Definition U := Type. - Parameter eq : Type = U. -End Foo. - -Module M : Foo with Definition U := Type. - Definition U := Type. - Definition eq : Type = U := eq_refl. -End M. - -Print Universes. -Fail Definition bad : False := TypeNeqSmallType.paradox M.U M.eq. -End NonPoly. - -Set Universe Polymorphism. - -Module Type Foo. - Definition U := Type. - Monomorphic Parameter eq : Type = U. -End Foo. - -Module M : Foo with Definition U := Type. - Definition U := Type. - Monomorphic Definition eq : Type = U := eq_refl. -End M. - -Fail Definition bad : False := TypeNeqSmallType.paradox Type M.eq. -(* Print Assumptions bad. *) diff --git a/test-suite/bugs/closed/4298.v b/test-suite/bugs/closed/4298.v deleted file mode 100644 index 875612ddf4..0000000000 --- a/test-suite/bugs/closed/4298.v +++ /dev/null @@ -1,7 +0,0 @@ -Set Universe Polymorphism. - -Module Type Foo. - Definition U := Type. -End Foo. - -Fail Module M : Foo with Definition U := Prop. diff --git a/test-suite/bugs/closed/4299.v b/test-suite/bugs/closed/4299.v deleted file mode 100644 index a1daa193ae..0000000000 --- a/test-suite/bugs/closed/4299.v +++ /dev/null @@ -1,12 +0,0 @@ -Unset Strict Universe Declaration. -Set Universe Polymorphism. - -Module Type Foo. - Definition U := Type : Type. - Parameter eq : Type = U. -End Foo. - -Module M : Foo with Definition U := Type : Type. - Definition U := let X := Type in Type. - Definition eq : Type = U := eq_refl. -Fail End M. diff --git a/test-suite/bugs/closed/4301.v b/test-suite/bugs/closed/4301.v deleted file mode 100644 index b4e17c2231..0000000000 --- a/test-suite/bugs/closed/4301.v +++ /dev/null @@ -1,13 +0,0 @@ -Unset Strict Universe Declaration. -Set Universe Polymorphism. - -Module Type Foo. - Parameter U : Type. -End Foo. - -Module Lower (X : Foo with Definition U := True : Type). -End Lower. - -Module M : Foo. - Definition U := nat : Type@{i}. -End M. diff --git a/test-suite/bugs/closed/4305.v b/test-suite/bugs/closed/4305.v deleted file mode 100644 index 39fc02d22b..0000000000 --- a/test-suite/bugs/closed/4305.v +++ /dev/null @@ -1,17 +0,0 @@ -(* Check fallback when an abbreviation is not interpretable as a pattern *) - -Notation foo := Type. - -Definition t := - match 0 with - | S foo => foo - | _ => 0 - end. - -Notation bar := (option Type). - -Definition u := - match 0 with - | S bar => bar - | _ => 0 - end. diff --git a/test-suite/bugs/closed/4306.v b/test-suite/bugs/closed/4306.v deleted file mode 100644 index 80c348d207..0000000000 --- a/test-suite/bugs/closed/4306.v +++ /dev/null @@ -1,32 +0,0 @@ -Require Import List. -Require Import Arith. -Require Import Recdef. -Require Import Omega. - -Function foo (xys : (list nat * list nat)) {measure (fun xys => length (fst xys) + length (snd xys))} : list nat := - match xys with - | (nil, _) => snd xys - | (_, nil) => fst xys - | (x :: xs', y :: ys') => match Nat.compare x y with - | Lt => x :: foo (xs', y :: ys') - | Eq => x :: foo (xs', ys') - | Gt => y :: foo (x :: xs', ys') - end - end. -Proof. - intros; simpl; omega. - intros; simpl; omega. - intros; simpl; omega. -Qed. - -Function bar (xys : (list nat * list nat)) {measure (fun xys => length (fst xys) + length (snd xys))} : list nat := - let (xs, ys) := xys in - match (xs, ys) with - | (nil, _) => ys - | (_, nil) => xs - | (x :: xs', y :: ys') => match Nat.compare x y with - | Lt => x :: foo (xs', ys) - | Eq => x :: foo (xs', ys') - | Gt => y :: foo (xs, ys') - end - end. diff --git a/test-suite/bugs/closed/4316.v b/test-suite/bugs/closed/4316.v deleted file mode 100644 index 68dec1334a..0000000000 --- a/test-suite/bugs/closed/4316.v +++ /dev/null @@ -1,3 +0,0 @@ -Ltac tac := idtac. -Reset tac. -Ltac tac := idtac. diff --git a/test-suite/bugs/closed/4318.v b/test-suite/bugs/closed/4318.v deleted file mode 100644 index e3140ed5ab..0000000000 --- a/test-suite/bugs/closed/4318.v +++ /dev/null @@ -1,2 +0,0 @@ -(* Check no anomaly is raised *) -Fail Definition foo p := match p with (x, y) z => tt end. diff --git a/test-suite/bugs/closed/4325.v b/test-suite/bugs/closed/4325.v deleted file mode 100644 index af69ca04b6..0000000000 --- a/test-suite/bugs/closed/4325.v +++ /dev/null @@ -1,5 +0,0 @@ -Goal (forall a b : nat, Set = (a = b)) -> Set. -Proof. - clear. - intro H. - erewrite (fun H' => H _ H'). diff --git a/test-suite/bugs/closed/4328.v b/test-suite/bugs/closed/4328.v deleted file mode 100644 index b40b3a4830..0000000000 --- a/test-suite/bugs/closed/4328.v +++ /dev/null @@ -1,6 +0,0 @@ -Inductive M (A:Type) : Type := M'. -Axiom pi : forall (P : Prop) (p : P), Prop. -Definition test1 A (x : _) := pi A x. (* success *) -Fail Definition test2 A (x : A) := pi A x. (* failure ??? *) -Fail Definition test3 A (x : A) (_ : M A) := pi A x. (* failure *) -Fail Definition test4 A (_ : M A) (x : A) := pi A x. (* success ??? *) diff --git a/test-suite/bugs/closed/4346.v b/test-suite/bugs/closed/4346.v deleted file mode 100644 index b50dff2411..0000000000 --- a/test-suite/bugs/closed/4346.v +++ /dev/null @@ -1,2 +0,0 @@ -Check (Set <: Type). -Check (Set <<: Type). diff --git a/test-suite/bugs/closed/4347.v b/test-suite/bugs/closed/4347.v deleted file mode 100644 index 29686a26c1..0000000000 --- a/test-suite/bugs/closed/4347.v +++ /dev/null @@ -1,17 +0,0 @@ -Fixpoint demo_recursion(n:nat) := match n with - |0 => Type - |S k => (demo_recursion k) -> Type - end. - -Record Demonstration := mkDemo -{ - demo_law : forall n:nat, demo_recursion n; - demo_stuff : forall n:nat, forall q:(fix demo_recursion (n : nat) : Type := - match n with - | 0 => Type - | S k => demo_recursion k -> Type - end) n, (demo_law (S n)) q -}. - -Theorem DemoError : Demonstration. -Fail apply mkDemo. (*Anomaly: Uncaught exception Not_found. Please report.*) diff --git a/test-suite/bugs/closed/4354.v b/test-suite/bugs/closed/4354.v deleted file mode 100644 index c55b4cf02a..0000000000 --- a/test-suite/bugs/closed/4354.v +++ /dev/null @@ -1,11 +0,0 @@ -Inductive True : Prop := I. -Class Lift (T : Type). -Axiom closed_increment : forall {T} {H : Lift T}, True. -Create HintDb core. -Lemma closed_monotonic T (H : Lift T) : True. -Proof. - Set Printing Universes. - auto using closed_increment. Show Universes. -Qed. -(* also fails with -nois, so the content of the hint database does not matter -*) diff --git a/test-suite/bugs/closed/4363.v b/test-suite/bugs/closed/4363.v deleted file mode 100644 index 9895548c1d..0000000000 --- a/test-suite/bugs/closed/4363.v +++ /dev/null @@ -1,9 +0,0 @@ -Set Printing Universes. -Definition foo : Type. -Proof. - assert (H : Set) by abstract (assert Type by abstract exact Type using bar; exact nat). - exact bar. -Defined. (* Toplevel input, characters 0-8: -Error: -The term "(fun _ : Set => bar) foo_subproof" has type -"Type@{Top.2}" while it is expected to have type "Type@{Top.1}". *) diff --git a/test-suite/bugs/closed/4366.v b/test-suite/bugs/closed/4366.v deleted file mode 100644 index 403c2d2026..0000000000 --- a/test-suite/bugs/closed/4366.v +++ /dev/null @@ -1,15 +0,0 @@ -Fixpoint stupid (n : nat) : unit := -match n with -| 0 => tt -| S n => - let () := stupid n in - let () := stupid n in - tt -end. - -Goal True. -Proof. -pose (v := stupid 24). -Timeout 4 vm_compute in v. -exact I. -Qed. diff --git a/test-suite/bugs/closed/4372.v b/test-suite/bugs/closed/4372.v deleted file mode 100644 index 428192a344..0000000000 --- a/test-suite/bugs/closed/4372.v +++ /dev/null @@ -1,20 +0,0 @@ -(* Tactic inversion was raising an anomaly because of a fake - dependency of TypeDenote into its argument *) - -Inductive expr := -| ETrue. - -Inductive IntermediateType : Set := ITbool. - -Definition TypeDenote (IT : IntermediateType) : Type := - match IT with - | _ => bool - end. - -Inductive ValueDenote : forall (e:expr) it, TypeDenote it -> Prop := -| VT : ValueDenote ETrue ITbool true. - -Goal forall it v, @ValueDenote ETrue it v -> True. - intros it v H. - inversion H. -Abort. diff --git a/test-suite/bugs/closed/4375.v b/test-suite/bugs/closed/4375.v deleted file mode 100644 index 468bade1cc..0000000000 --- a/test-suite/bugs/closed/4375.v +++ /dev/null @@ -1,107 +0,0 @@ - - -Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} := - t. - - -Module A. -Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => foo t n - end. -End A. - -Module B. -Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar@{i} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => foo t n - end. -End B. - -Module C. -Fail Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar@{j} (t : Type@{j}) (n : nat) : Type@{j} := - match n with - | 0 => t - | S n => foo t n - end. -End C. - -Module D. -Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar@{i j} (t : Type@{j}) (n : nat) : Type@{j} := - match n with - | 0 => t - | S n => foo t n - end. -End D. - -Module E. -Fail Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar@{j i} (t : Type@{j}) (n : nat) : Type@{j} := - match n with - | 0 => t - | S n => foo t n - end. -End E. - -(* -Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} := - t. - -Print g. - -Polymorphic Fixpoint a@{i} (t : Type@{i}) (n : nat) : Type@{i} := - t -with b@{i} (t : Type@{i}) (n : nat) : Type@{i} := - t. - -Print a. -Print b. -*) - -Polymorphic CoInductive foo@{i} (T : Type@{i}) : Type@{i} := -| A : foo T -> foo T. - -Polymorphic CoFixpoint cg@{i} (t : Type@{i}) : foo@{i} t := - @A@{i} t (cg t). - -Print cg. - -Polymorphic CoFixpoint ca@{i} (t : Type@{i}) : foo@{i} t := - @A@{i} t (cb t) -with cb@{i} (t : Type@{i}) : foo@{i} t := - @A@{i} t (ca t). - -Print ca. -Print cb. - diff --git a/test-suite/bugs/closed/4378.v b/test-suite/bugs/closed/4378.v deleted file mode 100644 index 9d59165562..0000000000 --- a/test-suite/bugs/closed/4378.v +++ /dev/null @@ -1,9 +0,0 @@ -Tactic Notation "epose" open_constr(a) := - let a' := fresh in - pose a as a'. -Tactic Notation "epose2" open_constr(a) tactic3(tac) := - let a' := fresh in - pose a as a'. -Goal True. - epose _. Undo. - epose2 _ idtac. diff --git a/test-suite/bugs/closed/4390.v b/test-suite/bugs/closed/4390.v deleted file mode 100644 index c069b2d9dc..0000000000 --- a/test-suite/bugs/closed/4390.v +++ /dev/null @@ -1,37 +0,0 @@ -Module A. -Set Printing All. -Set Printing Universes. - -Module M. -Section foo. -Universe i. -End foo. -End M. - -Check Type@{M.i}. -(* Succeeds *) - -Fail Check Type@{j}. -(* Error: Undeclared universe: j *) - -Definition foo@{j} : Type@{M.i} := Type@{j}. -(* ok *) -End A. -Import A. Import M. -Set Universe Polymorphism. -Fail Universes j. -Monomorphic Universe j. -Section foo. - Universes i. - Constraint i < j. - Definition foo : Type@{j} := Type@{i}. - Definition foo' : Type@{j} := Type@{i}. -End foo. - -Check eq_refl : foo@{i} = foo'@{i}. - -Definition bar := foo. -Monomorphic Definition bar'@{k} := foo@{k}. - -Fail Constraint j = j. -Monomorphic Constraint i = i. diff --git a/test-suite/bugs/closed/4397.v b/test-suite/bugs/closed/4397.v deleted file mode 100644 index 3566353d84..0000000000 --- a/test-suite/bugs/closed/4397.v +++ /dev/null @@ -1,3 +0,0 @@ -Require Import Equality. -Theorem foo (u : unit) (H : u = u) : True. -dependent destruction H. diff --git a/test-suite/bugs/closed/4403.v b/test-suite/bugs/closed/4403.v deleted file mode 100644 index a80f38fe2a..0000000000 --- a/test-suite/bugs/closed/4403.v +++ /dev/null @@ -1,3 +0,0 @@ -(* -*- coq-prog-args: ("-type-in-type"); -*- *) - -Definition some_prop : Prop := Type. diff --git a/test-suite/bugs/closed/4404.v b/test-suite/bugs/closed/4404.v deleted file mode 100644 index 27b43a61d4..0000000000 --- a/test-suite/bugs/closed/4404.v +++ /dev/null @@ -1,4 +0,0 @@ -Inductive Foo : Type -> Type := foo A : Foo A. -Goal True. - remember Foo. - diff --git a/test-suite/bugs/closed/4412.v b/test-suite/bugs/closed/4412.v deleted file mode 100644 index 4b2aae0c7b..0000000000 --- a/test-suite/bugs/closed/4412.v +++ /dev/null @@ -1,4 +0,0 @@ -Require Import Coq.Bool.Bool Coq.Setoids.Setoid. -Goal forall (P : forall b : bool, b = true -> Type) (x y : bool) (H : andb x y = true) (H' : P _ H), True. - intros. - Fail rewrite Bool.andb_true_iff in H. diff --git a/test-suite/bugs/closed/4416.v b/test-suite/bugs/closed/4416.v deleted file mode 100644 index 62b90b4286..0000000000 --- a/test-suite/bugs/closed/4416.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal exists x, x. -Unset Solve Unification Constraints. -unshelve refine (ex_intro _ _ _); match goal with _ => refine (_ _) end. -(* Error: Incorrect number of goals (expected 2 tactics). *) diff --git a/test-suite/bugs/closed/4420.v b/test-suite/bugs/closed/4420.v deleted file mode 100644 index 0e16cb2399..0000000000 --- a/test-suite/bugs/closed/4420.v +++ /dev/null @@ -1,19 +0,0 @@ -Module foo. - Context (Char : Type). - Axiom foo : Type -> Type. - Goal foo Char = foo Char. - change foo with (fun x => foo x). - cbv beta. - reflexivity. - Defined. -End foo. - -Inductive foo (A : Type) : Prop := I. (*Top.1*) -Lemma bar : foo Type. (*Top.3*) -Proof. - Set Printing Universes. -change foo with (fun x : Type => foo x). (*Top.4*) -cbv beta. -apply I. (* I Type@{Top.3} : (fun x : Type@{Top.4} => foo x) Type@{Top.3} *) -Defined. - diff --git a/test-suite/bugs/closed/4429.v b/test-suite/bugs/closed/4429.v deleted file mode 100644 index bf0e570ab8..0000000000 --- a/test-suite/bugs/closed/4429.v +++ /dev/null @@ -1,31 +0,0 @@ -Require Import Arith.Compare_dec. -Require Import Unicode.Utf8. - -Fixpoint my_nat_iter (n : nat) {A} (f : A → A) (x : A) : A := - match n with - | O => x - | S n' => f (my_nat_iter n' f x) - end. - -Definition gcd_IT_F (f : nat * nat → nat) (mn : nat * nat) : nat := - match mn with - | (0, 0) => 0 - | (0, S n') => S n' - | (S m', 0) => S m' - | (S m', S n') => - match le_gt_dec (S m') (S n') with - | left _ => f (S m', S n' - S m') - | right _ => f (S m' - S n', S n') - end - end. - -Axiom max_correct_l : ∀ m n : nat, m <= max m n. -Axiom max_correct_r : ∀ m n : nat, n <= max m n. - -Hint Resolve max_correct_l max_correct_r : arith. - -Theorem foo : ∀ p p' p'' : nat, p'' < S (max p (max p' p'')). -Proof. - intros. - Timeout 3 eauto with arith. -Qed. diff --git a/test-suite/bugs/closed/4433.v b/test-suite/bugs/closed/4433.v deleted file mode 100644 index 83c0e3f81f..0000000000 --- a/test-suite/bugs/closed/4433.v +++ /dev/null @@ -1,29 +0,0 @@ -Require Import Coq.Arith.Arith Coq.Init.Wf. -Axiom proof_admitted : False. -Goal exists x y z : nat, Fix - Wf_nat.lt_wf - (fun _ => nat -> nat) - (fun x' f => match x' as x'0 - return match x'0 with - | 0 => True - | S x'' => x'' < x' - end - -> nat -> nat - with - | 0 => fun _ _ => 0 - | S x'' => f x'' - end - (match x' with - | 0 => I - | S x'' => (Nat.lt_succ_diag_r _) - end)) - z - y - = 0. -Proof. - do 3 (eexists; [ shelve.. | ]). - match goal with |- ?G => let G' := (eval lazy in G) in change G with G' end. - case proof_admitted. - Unshelve. - all:constructor. -Defined. diff --git a/test-suite/bugs/closed/4443.v b/test-suite/bugs/closed/4443.v deleted file mode 100644 index a3a8717d98..0000000000 --- a/test-suite/bugs/closed/4443.v +++ /dev/null @@ -1,31 +0,0 @@ -Set Universe Polymorphism. - -Record TYPE@{i} := cType { - type : Type@{i}; -}. - -Definition PROD@{i j k} - (A : Type@{i}) - (B : A -> Type@{j}) - : TYPE@{k}. -Proof. - refine (cType@{i} _). -+ refine (forall x : A, B x). -Defined. - -Local Unset Strict Universe Declaration. -Definition PRODinj - (A : Type@{i}) - (B : A -> Type) - : TYPE. -Proof. - refine (cType@{i} _). -+ refine (forall x : A, B x). -Defined. - - Monomorphic Universe i j. - Monomorphic Constraint j < i. -Set Printing Universes. -Check PROD@{i i i}. -Check PRODinj@{i j}. -Fail Check PRODinj@{j i}. diff --git a/test-suite/bugs/closed/4450.v b/test-suite/bugs/closed/4450.v deleted file mode 100644 index c1fe44315a..0000000000 --- a/test-suite/bugs/closed/4450.v +++ /dev/null @@ -1,58 +0,0 @@ -Polymorphic Axiom inhabited@{u} : Type@{u} -> Prop. - -Polymorphic Axiom unit@{u} : Type@{u}. -Polymorphic Axiom tt@{u} : inhabited unit@{u}. - -Polymorphic Hint Resolve tt : the_lemmas. -Set Printing All. -Set Printing Universes. -Goal inhabited unit. -Proof. - eauto with the_lemmas. -Qed. - -Universe u. -Axiom f : Type@{u} -> Prop. -Lemma fapp (X : Type) : f X -> False. -Admitted. -Polymorphic Axiom funi@{i} : f unit@{i}. - -Goal (forall U, f U) -> (*(f unit -> False) -> *)False /\ False. - eauto using (fapp unit funi). (* The two fapp's have different universes *) -Qed. - -Hint Resolve (fapp unit funi) : mylems. - -Goal (forall U, f U) -> (*(f unit -> False) -> *)False /\ False. - eauto with mylems. (* Forces the two fapps at the same level *) -Qed. - -Goal (forall U, f U) -> (f unit -> False) -> False /\ False. - eauto. (* Forces the two fapps at the same level *) -Qed. - -Polymorphic Definition MyType@{i} := Type@{i}. -Universes l m n. -Constraint l < m. -Polymorphic Axiom maketype@{i} : MyType@{i}. - -Goal MyType@{l}. -Proof. - Fail solve [ eauto using maketype@{m} ]. - eauto using maketype. - Undo. - eauto using maketype@{n}. -Qed. - -Axiom foo : forall (A : Type), list A. -Polymorphic Axiom foop@{i} : forall (A : Type@{i}), list A. - -Universe x y. -Goal list Type@{x}. -Proof. - eauto using (foo Type). (* Refreshes the term *) - Undo. - eauto using foo. Show Universes. - Undo. - eauto using foop. Show Proof. Show Universes. -Qed. diff --git a/test-suite/bugs/closed/4453.v b/test-suite/bugs/closed/4453.v deleted file mode 100644 index 009dd5e3ca..0000000000 --- a/test-suite/bugs/closed/4453.v +++ /dev/null @@ -1,8 +0,0 @@ - -Section Foo. -Variable A : Type. -Lemma foo : A -> True. now intros _. Qed. -Goal Type -> True. -rename A into B. -intros A. -Fail apply foo. diff --git a/test-suite/bugs/closed/4456.v b/test-suite/bugs/closed/4456.v deleted file mode 100644 index 56a7b4f6e9..0000000000 --- a/test-suite/bugs/closed/4456.v +++ /dev/null @@ -1,647 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerMin" "-R" "." "Top") -*- *) -(* File reduced by coq-bug-finder from original input, then from 2475 lines to 729 lines, then from 746 lines to 658 lines, then from 675 lines to 658 lines *) -(* coqc version 8.5beta3 (November 2015) compiled on Nov 11 2015 18:23:0 with OCaml 4.01.0 - coqtop version 8.5beta3 (November 2015) *) -(* Variable P : forall n m : nat, n = m -> Prop. *) -(* Axiom Prefl : forall n : nat, P n n eq_refl. *) -Axiom proof_admitted : False. - -Tactic Notation "admit" := case proof_admitted. - -Require Coq.Program.Program. -Require Coq.Strings.String. -Require Coq.omega.Omega. -Module Export Fiat_DOT_Common. -Module Export Fiat. -Module Common. -Import Coq.Lists.List. -Export Coq.Program.Program. - -Global Set Implicit Arguments. - -Global Coercion is_true : bool >-> Sortclass. -Coercion bool_of_sum {A B} (b : sum A B) : bool := if b then true else false. - -Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type - := match ls return Type with - | nil => True - | x::xs => (P x * ForallT P xs)%type - end. -Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type - := match ls with - | nil => P nil - | x::xs => (P (x::xs) * Forall_tails P xs)%type - end. - -End Common. - -End Fiat. - -End Fiat_DOT_Common. -Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Core. -Module Export Fiat. -Module Export Parsers. -Module Export StringLike. -Module Export Core. -Import Coq.Relations.Relation_Definitions. -Import Coq.Classes.Morphisms. - -Local Coercion is_true : bool >-> Sortclass. - -Module Export StringLike. - Class StringLike {Char : Type} := - { - String :> Type; - is_char : String -> Char -> bool; - length : String -> nat; - take : nat -> String -> String; - drop : nat -> String -> String; - get : nat -> String -> option Char; - unsafe_get : nat -> String -> Char; - bool_eq : String -> String -> bool; - beq : relation String := fun x y => bool_eq x y - }. - - Arguments StringLike : clear implicits. - Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope. - Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope. - Local Open Scope string_like_scope. - - Class StringLikeProperties (Char : Type) `{StringLike Char} := - { - singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch'; - singleton_exists : forall s, length s = 1 -> exists ch, s ~= [ ch ]; - get_0 : forall s ch, take 1 s ~= [ ch ] <-> get 0 s = Some ch; - get_S : forall n s, get (S n) s = get n (drop 1 s); - unsafe_get_correct : forall n s ch, get n s = Some ch -> unsafe_get n s = ch; - length_singleton : forall s ch, s ~= [ ch ] -> length s = 1; - bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s'; - is_char_Proper :> Proper (beq ==> eq ==> eq) is_char; - length_Proper :> Proper (beq ==> eq) length; - take_Proper :> Proper (eq ==> beq ==> beq) take; - drop_Proper :> Proper (eq ==> beq ==> beq) drop; - bool_eq_Equivalence :> Equivalence beq; - bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str'; - take_short_length : forall str n, n <= length str -> length (take n str) = n; - take_long : forall str n, length str <= n -> take n str =s str; - take_take : forall str n m, take n (take m str) =s take (min n m) str; - drop_length : forall str n, length (drop n str) = length str - n; - drop_0 : forall str, drop 0 str =s str; - drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str; - drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str); - take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str); - bool_eq_from_get : forall str str', (forall n, get n str = get n str') -> str =s str' - }. -Global Arguments StringLikeProperties _ {_}. -End StringLike. - -End Core. - -End StringLike. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_StringLike_DOT_Core. - -Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core. -Module Export Fiat. -Module Export Parsers. -Module Export ContextFreeGrammar. -Module Export Core. -Import Coq.Strings.String. -Import Coq.Lists.List. -Export Fiat.Parsers.StringLike.Core. - -Section cfg. - Context {Char : Type}. - - Section definitions. - - Inductive item := - | Terminal (_ : Char) - | NonTerminal (_ : string). - - Definition production := list item. - Definition productions := list production. - - Record grammar := - { - Start_symbol :> string; - Lookup :> string -> productions; - Start_productions :> productions := Lookup Start_symbol; - Valid_nonterminals : list string; - Valid_productions : list productions := map Lookup Valid_nonterminals - }. - End definitions. - - End cfg. - -Arguments item _ : clear implicits. -Arguments production _ : clear implicits. -Arguments productions _ : clear implicits. -Arguments grammar _ : clear implicits. - -End Core. - -End ContextFreeGrammar. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core. - -Module Export Fiat_DOT_Parsers_DOT_BaseTypes. -Module Export Fiat. -Module Export Parsers. -Module Export BaseTypes. -Import Coq.Arith.Wf_nat. - -Local Coercion is_true : bool >-> Sortclass. - -Section recursive_descent_parser. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - - Class parser_computational_predataT := - { nonterminals_listT : Type; - nonterminal_carrierT : Type; - of_nonterminal : String.string -> nonterminal_carrierT; - to_nonterminal : nonterminal_carrierT -> String.string; - initial_nonterminals_data : nonterminals_listT; - nonterminals_length : nonterminals_listT -> nat; - is_valid_nonterminal : nonterminals_listT -> nonterminal_carrierT -> bool; - remove_nonterminal : nonterminals_listT -> nonterminal_carrierT -> nonterminals_listT }. - - Class parser_removal_dataT' `{predata : parser_computational_predataT} := - { nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop - := ltof _ nonterminals_length; - nonterminals_length_zero : forall ls, - nonterminals_length ls = 0 - -> forall nt, is_valid_nonterminal ls nt = false; - remove_nonterminal_dec : forall ls nonterminal, - is_valid_nonterminal ls nonterminal - -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; - remove_nonterminal_noninc : forall ls nonterminal, - ~nonterminals_listT_R ls (remove_nonterminal ls nonterminal); - initial_nonterminals_correct : forall nonterminal, - is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal) <-> List.In nonterminal (Valid_nonterminals G); - initial_nonterminals_correct' : forall nonterminal, - is_valid_nonterminal initial_nonterminals_data nonterminal <-> List.In (to_nonterminal nonterminal) (Valid_nonterminals G); - to_of_nonterminal : forall nonterminal, - List.In nonterminal (Valid_nonterminals G) - -> to_nonterminal (of_nonterminal nonterminal) = nonterminal; - of_to_nonterminal : forall nonterminal, - is_valid_nonterminal initial_nonterminals_data nonterminal - -> of_nonterminal (to_nonterminal nonterminal) = nonterminal; - ntl_wf : well_founded nonterminals_listT_R - := well_founded_ltof _ _; - remove_nonterminal_1 - : forall ls ps ps', - is_valid_nonterminal (remove_nonterminal ls ps) ps' - -> is_valid_nonterminal ls ps'; - remove_nonterminal_2 - : forall ls ps ps', - is_valid_nonterminal (remove_nonterminal ls ps) ps' = false - <-> is_valid_nonterminal ls ps' = false \/ ps = ps' }. - - Class split_dataT := - { split_string_for_production - : item Char -> production Char -> String -> list nat }. - - Class boolean_parser_dataT := - { predata :> parser_computational_predataT; - split_data :> split_dataT }. -End recursive_descent_parser. - -End BaseTypes. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_BaseTypes. - -Module Export Fiat_DOT_Common_DOT_List_DOT_Operations. -Module Export Fiat. -Module Export Common. -Module Export List. -Module Export Operations. - -Import Coq.Lists.List. - -Module Export List. - Section InT. - Context {A : Type} (a : A). - - Fixpoint InT (ls : list A) : Set - := match ls return Set with - | nil => False - | b :: m => (b = a) + InT m - end%type. - End InT. - - End List. - -End Operations. - -End List. - -End Common. - -End Fiat. - -End Fiat_DOT_Common_DOT_List_DOT_Operations. - -Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties. -Module Export Fiat. -Module Export Parsers. -Module Export StringLike. -Module Export Properties. - -Section String. - Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char}. - - Lemma take_length {str n} - : length (take n str) = min n (length str). -admit. -Defined. - - End String. - -End Properties. - -End StringLike. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties. - -Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties. -Module Export Fiat. -Module Export Parsers. -Module Export ContextFreeGrammar. -Module Export Properties. - -Local Open Scope list_scope. -Definition production_is_reachableT {Char} (G : grammar Char) (p : production Char) - := { nt : _ - & { prefix : _ - & List.In nt (Valid_nonterminals G) - * List.InT - (prefix ++ p) - (Lookup G nt) } }%type. - -End Properties. - -End ContextFreeGrammar. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties. - -Module Export Fiat_DOT_Parsers_DOT_MinimalParse. -Module Export Fiat. -Module Export Parsers. -Module Export MinimalParse. -Import Coq.Lists.List. -Import Fiat.Parsers.ContextFreeGrammar.Core. - -Local Coercion is_true : bool >-> Sortclass. -Local Open Scope string_like_scope. - -Section cfg. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - Context {predata : @parser_computational_predataT} - {rdata' : @parser_removal_dataT' _ G predata}. - - Inductive minimal_parse_of - : forall (len0 : nat) (valid : nonterminals_listT) - (str : String), - productions Char -> Type := - | MinParseHead : forall len0 valid str pat pats, - @minimal_parse_of_production len0 valid str pat - -> @minimal_parse_of len0 valid str (pat::pats) - | MinParseTail : forall len0 valid str pat pats, - @minimal_parse_of len0 valid str pats - -> @minimal_parse_of len0 valid str (pat::pats) - with minimal_parse_of_production - : forall (len0 : nat) (valid : nonterminals_listT) - (str : String), - production Char -> Type := - | MinParseProductionNil : forall len0 valid str, - length str = 0 - -> @minimal_parse_of_production len0 valid str nil - | MinParseProductionCons : forall len0 valid str n pat pats, - length str <= len0 - -> @minimal_parse_of_item len0 valid (take n str) pat - -> @minimal_parse_of_production len0 valid (drop n str) pats - -> @minimal_parse_of_production len0 valid str (pat::pats) - with minimal_parse_of_item - : forall (len0 : nat) (valid : nonterminals_listT) - (str : String), - item Char -> Type := - | MinParseTerminal : forall len0 valid str ch, - str ~= [ ch ] - -> @minimal_parse_of_item len0 valid str (Terminal ch) - | MinParseNonTerminal - : forall len0 valid str (nt : String.string), - @minimal_parse_of_nonterminal len0 valid str nt - -> @minimal_parse_of_item len0 valid str (NonTerminal nt) - with minimal_parse_of_nonterminal - : forall (len0 : nat) (valid : nonterminals_listT) - (str : String), - String.string -> Type := - | MinParseNonTerminalStrLt - : forall len0 valid (nt : String.string) str, - length str < len0 - -> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt) - -> @minimal_parse_of (length str) initial_nonterminals_data str (Lookup G nt) - -> @minimal_parse_of_nonterminal len0 valid str nt - | MinParseNonTerminalStrEq - : forall len0 str valid nonterminal, - length str = len0 - -> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal) - -> is_valid_nonterminal valid (of_nonterminal nonterminal) - -> @minimal_parse_of len0 (remove_nonterminal valid (of_nonterminal nonterminal)) str (Lookup G nonterminal) - -> @minimal_parse_of_nonterminal len0 valid str nonterminal. - -End cfg. - -End MinimalParse. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_MinimalParse. - -Module Export Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes. -Module Export Fiat. -Module Export Parsers. -Module Export CorrectnessBaseTypes. -Import Coq.Lists.List. -Import Fiat.Parsers.ContextFreeGrammar.Core. -Import Fiat_DOT_Common.Fiat.Common. -Section general. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - - Definition split_list_completeT_for {data : @parser_computational_predataT} - {len0 valid} - (it : item Char) (its : production Char) - (str : String) - (pf : length str <= len0) - (split_list : list nat) - - := ({ n : nat - & (minimal_parse_of_item (G := G) (predata := data) len0 valid (take n str) it) - * (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type) - -> ({ n : nat - & (In (min (length str) n) (map (min (length str)) split_list)) - * (minimal_parse_of_item (G := G) len0 valid (take n str) it) - * (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type). - - Definition split_list_completeT {data : @parser_computational_predataT} - (splits : item Char -> production Char -> String -> list nat) - := forall len0 valid str (pf : length str <= len0) nt, - is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt) - -> ForallT - (Forall_tails - (fun prod - => match prod return Type with - | nil => True - | it::its - => @split_list_completeT_for data len0 valid it its str pf (splits it its str) - end)) - (Lookup G nt). - - Class boolean_parser_completeness_dataT' {data : boolean_parser_dataT} := - { split_string_for_production_complete - : split_list_completeT split_string_for_production }. -End general. - -End CorrectnessBaseTypes. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes. - -Module Export Fiat. -Module Export Parsers. -Module Export ContextFreeGrammar. -Module Export Valid. -Export Fiat.Parsers.StringLike.Core. - -Section cfg. - Context {Char : Type} {HSL : StringLike Char} (G : grammar Char) - {predata : parser_computational_predataT}. - - Definition item_valid (it : item Char) - := match it with - | Terminal _ => True - | NonTerminal nt' => is_true (is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt')) - end. - - Definition production_valid pat - := List.Forall item_valid pat. - - Definition productions_valid pats - := List.Forall production_valid pats. - - Definition grammar_valid - := forall nt, - List.In nt (Valid_nonterminals G) - -> productions_valid (Lookup G nt). -End cfg. - -End Valid. - -Section app. - Context {Char : Type} {HSL : StringLike Char} (G : grammar Char) - {predata : parser_computational_predataT}. - - Lemma hd_production_valid - (it : item Char) - (its : production Char) - (H : production_valid (it :: its)) - : item_valid it. -admit. -Defined. - - Lemma production_valid_cons - (it : item Char) - (its : production Char) - (H : production_valid (it :: its)) - : production_valid its. -admit. -Defined. - - End app. - -Import Coq.Lists.List. -Import Coq.omega.Omega. -Import Fiat_DOT_Common.Fiat.Common. -Import Fiat.Parsers.ContextFreeGrammar.Valid. -Local Open Scope string_like_scope. - -Section recursive_descent_parser. - Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char). - Context {data : @boolean_parser_dataT Char _} - {cdata : @boolean_parser_completeness_dataT' Char _ G data} - {rdata : @parser_removal_dataT' _ G _} - {gvalid : grammar_valid G}. - - Local Notation dec T := (T + (T -> False))%type (only parsing). - - Local Notation iffT x y := ((x -> y) * (y -> x))%type (only parsing). - - Lemma dec_prod {A B} (HA : dec A) (HB : dec B) : dec (A * B). -admit. -Defined. - - Lemma dec_In {A} {P : A -> Type} (HA : forall a, dec (P a)) ls - : dec { a : _ & (In a ls * P a) }. -admit. -Defined. - - Section item. - Context {len0 valid} - (str : String) - (str_matches_nonterminal' - : nonterminal_carrierT -> bool) - (str_matches_nonterminal - : forall nt : nonterminal_carrierT, - dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))). - - Section valid. - Context (Hmatches - : forall nt, - is_valid_nonterminal initial_nonterminals_data nt - -> str_matches_nonterminal nt = str_matches_nonterminal' nt :> bool) - (it : item Char) - (Hvalid : item_valid it). - - Definition parse_item' - : dec (minimal_parse_of_item (G := G) len0 valid str it). - Proof. - clear Hvalid. - refine (match it return dec (minimal_parse_of_item len0 valid str it) with - | Terminal ch => if Sumbool.sumbool_of_bool (str ~= [ ch ]) - then inl (MinParseTerminal _ _ _ _ _) - else inr (fun _ => !) - | NonTerminal nt => if str_matches_nonterminal (of_nonterminal nt) - then inl (MinParseNonTerminal _) - else inr (fun _ => !) - end); - clear str_matches_nonterminal Hmatches; - admit. - Defined. - End valid. - - End item. - Context {len0 valid} - (parse_nonterminal - : forall (str : String) (len : nat) (Hlen : length str = len) (pf : len <= len0) (nt : nonterminal_carrierT), - dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))). - - Lemma dec_in_helper {ls it its str} - : iffT {n0 : nat & - (In (min (length str) n0) (map (min (length str)) ls) * - minimal_parse_of_item (G := G) len0 valid (take n0 str) it * - minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type} - {n0 : nat & - (In n0 ls * - (minimal_parse_of_item (G := G) len0 valid (take n0 str) it * - minimal_parse_of_production (G := G) len0 valid (drop n0 str) its))%type}. -admit. -Defined. - - Lemma parse_production'_helper {str it its} (pf : length str <= len0) - : dec {n0 : nat & - (minimal_parse_of_item (G := G) len0 valid (take n0 str) it * - minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type} - -> dec (minimal_parse_of_production (G := G) len0 valid str (it :: its)). -admit. -Defined. - Local Ltac t_parse_production_for := repeat - match goal with - | [ H : (beq_nat _ _) = true |- _ ] => apply EqNat.beq_nat_true in H - | _ => progress subst - | _ => solve [ constructor; assumption ] - | [ H : minimal_parse_of_production _ _ _ nil |- _ ] => (inversion H; clear H) - | [ H : minimal_parse_of_production _ _ _ (_::_) |- _ ] => (inversion H; clear H) - | [ H : ?x = 0, H' : context[?x] |- _ ] => rewrite H in H' - | _ => progress simpl in * - | _ => discriminate - | [ H : forall x, (_ * _)%type -> _ |- _ ] => specialize (fun x y z => H x (y, z)) - | _ => solve [ eauto with nocore ] - | _ => solve [ apply Min.min_case_strong; omega ] - | _ => omega - | [ H : production_valid (_::_) |- _ ] - => let H' := fresh in - pose proof H as H'; - apply production_valid_cons in H; - apply hd_production_valid in H' - end. - - Definition parse_production'_for - (splits : item Char -> production Char -> String -> list nat) - (Hsplits : forall str it its (Hreachable : production_is_reachableT G (it::its)) pf', split_list_completeT_for (len0 := len0) (G := G) (valid := valid) it its str pf' (splits it its str)) - (str : String) - (len : nat) - (Hlen : length str = len) - (pf : len <= len0) - (prod : production Char) - (Hreachable : production_is_reachableT G prod) - : dec (minimal_parse_of_production (G := G) len0 valid str prod). - Proof. - revert prod Hreachable str len Hlen pf. - refine - ((fun pf_helper => - list_rect - (fun prod => - forall (Hreachable : production_is_reachableT G prod) - (str : String) - (len : nat) - (Hlen : length str = len) - (pf : len <= len0), - dec (minimal_parse_of_production (G := G) len0 valid str prod)) - ( - fun Hreachable str len Hlen pf - => match Utils.dec (beq_nat len 0) with - | left H => inl _ - | right H => inr (fun p => _) - end) - (fun it its parse_production' Hreachable str len Hlen pf - => parse_production'_helper - _ - (let parse_item := (fun n pf => parse_item' (parse_nonterminal (take n str) (len := min n len) (eq_trans take_length (f_equal (min _) Hlen)) pf) it) in - let parse_item := (fun n => parse_item n (Min.min_case_strong n len (fun k => k <= len0) (fun Hlen => (Nat.le_trans _ _ _ Hlen pf)) (fun Hlen => pf))) in - let parse_production := (fun n => parse_production' (pf_helper it its Hreachable) (drop n str) (len - n) (eq_trans (drop_length _ _) (f_equal (fun x => x - _) Hlen)) (Nat.le_trans _ _ _ (Nat.le_sub_l _ _) pf)) in - match dec_In - (fun n => dec_prod (parse_item n) (parse_production n)) - (splits it its str) - with - | inl p => inl (existT _ (projT1 p) (snd (projT2 p))) - | inr p - => let pf' := (Nat.le_trans _ _ _ (Nat.eq_le_incl _ _ Hlen) pf) in - let H := (_ : split_list_completeT_for (G := G) (len0 := len0) (valid := valid) it its str pf' (splits it its str)) in - inr (fun p' => p (fst dec_in_helper (H p'))) - end) - )) _); - [ clear parse_nonterminal Hsplits splits rdata cdata - | clear parse_nonterminal Hsplits splits rdata cdata - | .. - | admit ]. - abstract t_parse_production_for. - abstract t_parse_production_for. - abstract t_parse_production_for. - abstract t_parse_production_for. - Defined. diff --git a/test-suite/bugs/closed/4462.v b/test-suite/bugs/closed/4462.v deleted file mode 100644 index c680518c6a..0000000000 --- a/test-suite/bugs/closed/4462.v +++ /dev/null @@ -1,7 +0,0 @@ -Variables P Q : Prop. -Axiom pqrw : P <-> Q. - -Require Setoid. - -Goal P -> Q. -unshelve (rewrite pqrw). diff --git a/test-suite/bugs/closed/4464.v b/test-suite/bugs/closed/4464.v deleted file mode 100644 index f8e9405d93..0000000000 --- a/test-suite/bugs/closed/4464.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal True -> True. -Proof. - intro H'. - let H := H' in destruct H; try destruct H. diff --git a/test-suite/bugs/closed/4467.v b/test-suite/bugs/closed/4467.v deleted file mode 100644 index 6f8631d458..0000000000 --- a/test-suite/bugs/closed/4467.v +++ /dev/null @@ -1,15 +0,0 @@ -(* Fixing missing test for variable shadowing *) - -Definition test (x y:bool*bool) := - match x with - | (e as e1, (true) as e2) - | ((true) as e1, e as e2) => - let '(e, b) := y in - e - | _ => true - end. - -Goal test (true,false) (true,true) = true. -(* used to evaluate to "false = true" in 8.4 *) -reflexivity. -Qed. diff --git a/test-suite/bugs/closed/4471.v b/test-suite/bugs/closed/4471.v deleted file mode 100644 index 36efc42d47..0000000000 --- a/test-suite/bugs/closed/4471.v +++ /dev/null @@ -1,6 +0,0 @@ -Goal forall (A B : Type) (P : forall _ : prod A B, Type) (a : A) (b : B) (p p0 : forall (x : A) (x' : B), P (@pair A B x x')), - @eq (P (@pair A B a b)) (p (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b))) - (p0 (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b))). -Proof. - intros. - Fail generalize dependent (a, b). diff --git a/test-suite/bugs/closed/4479.v b/test-suite/bugs/closed/4479.v deleted file mode 100644 index 921579d1e1..0000000000 --- a/test-suite/bugs/closed/4479.v +++ /dev/null @@ -1,3 +0,0 @@ -Goal True. -Fail autorewrite with foo. -try autorewrite with foo. diff --git a/test-suite/bugs/closed/4480.v b/test-suite/bugs/closed/4480.v deleted file mode 100644 index 98c05ee1a8..0000000000 --- a/test-suite/bugs/closed/4480.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Setoid. - -Definition proj (P Q : Prop) := P. - -Lemma foo (P : Prop) : proj P P = P. -Admitted. -Lemma trueI : True <-> True. -Admitted. -Goal True. - Fail setoid_rewrite foo. - Fail setoid_rewrite trueI. - diff --git a/test-suite/bugs/closed/4484.v b/test-suite/bugs/closed/4484.v deleted file mode 100644 index f988539d62..0000000000 --- a/test-suite/bugs/closed/4484.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Testing 8.5 regression with type classes not solving evars - redefined while trying to solve them with the type class mechanism *) - -Class A := {}. -Axiom foo : forall {ac : A}, bool. -Lemma bar (ac : A) : True. -Check (match foo as k return foo = k -> True with - | true => _ - | false => _ - end eq_refl). diff --git a/test-suite/bugs/closed/4495.v b/test-suite/bugs/closed/4495.v deleted file mode 100644 index 8b032db5f5..0000000000 --- a/test-suite/bugs/closed/4495.v +++ /dev/null @@ -1 +0,0 @@ -Fail Notation "'forall' x .. y ',' P " := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder). diff --git a/test-suite/bugs/closed/4498.v b/test-suite/bugs/closed/4498.v deleted file mode 100644 index 379e46b3e3..0000000000 --- a/test-suite/bugs/closed/4498.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Export Coq.Unicode.Utf8. -Require Export Coq.Classes.Morphisms. -Require Export Coq.Relations.Relation_Definitions. - -Set Universe Polymorphism. - -Reserved Notation "a ~> b" (at level 90, right associativity). - -Class Category := { - ob : Type; - uhom := Type : Type; - hom : ob → ob → uhom where "a ~> b" := (hom a b); - compose : ∀ {A B C}, (B ~> C) → (A ~> B) → (A ~> C); - equiv : ∀ {A B}, relation (A ~> B); - is_equiv : ∀ {A B}, @Equivalence (A ~> B) equiv; - comp_respects : ∀ {A B C}, - Proper (@equiv B C ==> @equiv A B ==> @equiv A C) (@compose A B C); -}. - -Require Export Coq.Setoids.Setoid. - -Add Parametric Morphism `{C : Category} {A B C} : (@compose _ A B C) with - signature equiv ==> equiv ==> equiv as compose_mor. -Proof. apply comp_respects. Qed. diff --git a/test-suite/bugs/closed/4503.v b/test-suite/bugs/closed/4503.v deleted file mode 100644 index 5162f352df..0000000000 --- a/test-suite/bugs/closed/4503.v +++ /dev/null @@ -1,37 +0,0 @@ -Require Coq.Classes.RelationClasses. - -Class PreOrder (A : Type) (r : A -> A -> Type) : Type := -{ refl : forall x, r x x }. - -(* FAILURE 1 *) - -Section foo. - Polymorphic Universes A. - Polymorphic Context {A : Type@{A}} {rA : A -> A -> Prop} {PO : PreOrder A rA}. - - Fail Definition foo := PO. -End foo. - - -Module ILogic. - -Set Universe Polymorphism. - -(* Logical connectives *) -Class ILogic@{L} (A : Type@{L}) : Type := mkILogic -{ - lentails: A -> A -> Prop; - lentailsPre:> RelationClasses.PreOrder lentails -}. - - -End ILogic. - -Set Printing Universes. - -(* There is stil a problem if the class is universe polymorphic *) -Section Embed_ILogic_Pre. - Polymorphic Universes A T. - Fail Context {A : Type@{A}} {ILA: ILogic.ILogic@{A} A}. - -End Embed_ILogic_Pre. diff --git a/test-suite/bugs/closed/4511.v b/test-suite/bugs/closed/4511.v deleted file mode 100644 index 0cdb3aee4f..0000000000 --- a/test-suite/bugs/closed/4511.v +++ /dev/null @@ -1,3 +0,0 @@ -Goal True. -Fail evar I. - diff --git a/test-suite/bugs/closed/4519.v b/test-suite/bugs/closed/4519.v deleted file mode 100644 index 945183fae7..0000000000 --- a/test-suite/bugs/closed/4519.v +++ /dev/null @@ -1,21 +0,0 @@ -Set Universe Polymorphism. -Section foo. - Universe i. - Context (foo : Type@{i}) (bar : Type@{i}). - Definition qux@{i} (baz : Type@{i}) := foo -> bar. -End foo. -Set Printing Universes. -Print qux. (* qux@{Top.42 Top.43} = -fun foo bar _ : Type@{Top.42} => foo -> bar - : Type@{Top.42} -> Type@{Top.42} -> Type@{Top.42} -> Type@{Top.42} -(* Top.42 Top.43 |= *) -(* This is wrong; the first two types are equal, but the last one is not *) - -qux is universe polymorphic -Argument scopes are [type_scope type_scope type_scope] - *) -Check qux nat nat nat : Set. -Check qux nat nat Set : Set. (* Error: -The term "qux@{Top.50 Top.51} ?T ?T0 Set" has type "Type@{Top.50}" while it is -expected to have type "Set" -(universe inconsistency: Cannot enforce Top.50 = Set because Set < Top.50). *) diff --git a/test-suite/bugs/closed/4527.v b/test-suite/bugs/closed/4527.v deleted file mode 100644 index f8cedfff6e..0000000000 --- a/test-suite/bugs/closed/4527.v +++ /dev/null @@ -1,270 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_bad_univ_length_01") -*- *) -(* File reduced by coq-bug-finder from original input, then from 1199 lines to -430 lines, then from 444 lines to 430 lines, then from 964 lines to 255 lines, -then from 269 lines to 255 lines *) -(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml -4.01.0 - coqtop version 8.5 (January 2016) *) -Declare ML Module "ltac_plugin". -Inductive False := . -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Coq.Init.Datatypes. - -Import Coq.Init.Notations. - -Global Set Universe Polymorphism. - -Notation "A -> B" := (forall (_ : A), B) : type_scope. - -Inductive True : Type := - I : True. -Module Export Datatypes. - -Set Implicit Arguments. -Notation nat := Coq.Init.Datatypes.nat. -Notation O := Coq.Init.Datatypes.O. -Notation S := Coq.Init.Datatypes.S. -Notation two := (S (S O)). - -Record prod (A B : Type) := pair { fst : A ; snd : B }. - -Notation "x * y" := (prod x y) : type_scope. - -Open Scope nat_scope. - -End Datatypes. -Module Export Specif. - -Set Implicit Arguments. - -Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P -proj1_sig }. - -Notation sigT := sig (only parsing). - -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. - -Notation projT1 := proj1_sig (only parsing). -Notation projT2 := proj2_sig (only parsing). - -End Specif. -Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. - -Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in -Type@{i}. - -Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in - let ge := ((fun x => x) : Type1@{j} -> -Type@{i}) in Type@{i}. - -Notation idmap := (fun x => x). -Delimit Scope function_scope with function. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Open Scope fibration_scope. -Open Scope function_scope. - -Notation pr1 := projT1. -Notation pr2 := projT2. - -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left -associativity) : function_scope. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. - -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. - -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : -type_scope. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) -}. - -Arguments eisretr {A B}%type_scope f%function_scope {_} _. -Arguments eissect {A B}%type_scope f%function_scope {_} _. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : -function_scope. - -Inductive Unit : Type1 := - tt : Unit. - -Local Open Scope path_scope. - -Section EquivInverse. - - Context {A B : Type} (f : A -> B) {feq : IsEquiv f}. - - Theorem other_adj (b : B) : eissect f (f^-1 b) = ap f^-1 (eisretr f b). -admit. -Defined. - - Global Instance isequiv_inverse : IsEquiv f^-1 | 10000 - := BuildIsEquiv B A f^-1 f (eissect f) (eisretr f) other_adj. -End EquivInverse. - -Section Adjointify. - - Context {A B : Type} (f : A -> B) (g : B -> A). - Context (isretr : Sect g f) (issect : Sect f g). - - Let issect' := fun x => - ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. - - Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). -admit. -Defined. - - Definition isequiv_adjointify : IsEquiv f - := BuildIsEquiv A B f g isretr issect' is_adjoint'. - -End Adjointify. - - Definition ExtensionAlong {A B : Type} (f : A -> B) - (P : B -> Type) (d : forall x:A, P (f x)) - := { s : forall y:B, P y & forall x:A, s (f x) = d x }. - - Fixpoint ExtendableAlong@{i j k l} - (n : nat) {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := match n with - | O => Unit@{l} - | S n => (forall (g : forall a, C (f a)), - ExtensionAlong@{i j k l l} f C g) * - forall (h k : forall b, C b), - ExtendableAlong n f (fun b => h b = k b) - end. - - Definition ooExtendableAlong@{i j k l} - {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := forall n, ExtendableAlong@{i j k l} n f C. - -Module Type ReflectiveSubuniverses. - - Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. - - Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : -Type@{i}), - In@{u a i} O (O_reflector@{u a i} O T). - - Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : -Type@{i}), - T -> O_reflector@{u a i} O T. - - Parameter inO_equiv_inO@{u a i j k} : - forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) - (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), - - let gei := ((fun x => x) : Type@{i} -> Type@{k}) in - let gej := ((fun x => x) : Type@{j} -> Type@{k}) in - In@{u a j} O U. - - Parameter extendable_to_O@{u a i j k} - : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : -Type2le@{j a}} {Q_inO : In@{u a j} O Q}, - ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). - -End ReflectiveSubuniverses. - -Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). -Export Os. - -Existing Class In. - - Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. - -Arguments inO_equiv_inO {O} T {U} {_} f {_}. -Global Existing Instance O_inO. - -Section ORecursion. - Context {O : ReflectiveSubuniverse}. - - Definition O_indpaths {P Q : Type} {Q_inO : In O Q} - (g h : O P -> Q) (p : g o to O P == h o to O P) - : g == h - := (fst (snd (extendable_to_O O two) g h) p).1. - - Definition O_indpaths_beta {P Q : Type} {Q_inO : In O Q} - (g h : O P -> Q) (p : g o (to O P) == h o (to O P)) (x : P) - : O_indpaths g h p (to O P x) = p x - := (fst (snd (extendable_to_O O two) g h) p).2 x. - -End ORecursion. - -Section Reflective_Subuniverse. - Universes Ou Oa. - Context (O : ReflectiveSubuniverse@{Ou Oa}). - - Definition inO_isequiv_to_O (T:Type) - : IsEquiv (to O T) -> In O T - := fun _ => inO_equiv_inO (O T) (to O T)^-1. - - Definition inO_to_O_retract (T:Type) (mu : O T -> T) - : Sect (to O T) mu -> In O T. - Proof. - unfold Sect; intros H. - apply inO_isequiv_to_O. - apply isequiv_adjointify with (g:=mu). - - - refine (O_indpaths (to O T o mu) idmap _). - intros x; exact (ap (to O T) (H x)). - - - exact H. - Defined. - - Definition inO_paths@{i} (S : Type@{i}) {S_inO : In@{Ou Oa i} O S} (x y : -S) : In@{Ou Oa i} O (x=y). - Proof. - simple refine (inO_to_O_retract@{i} _ _ _); intro u. - - - assert (p : (fun _ : O (x=y) => x) == (fun _=> y)). - { - refine (O_indpaths _ _ _); simpl. - intro v; exact v. -} - exact (p u). - - - hnf. - rewrite O_indpaths_beta; reflexivity. - Qed. - Check inO_paths@{Type}. diff --git a/test-suite/bugs/closed/4529.v b/test-suite/bugs/closed/4529.v deleted file mode 100644 index 8b3c24fec6..0000000000 --- a/test-suite/bugs/closed/4529.v +++ /dev/null @@ -1,45 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 1334 lines to 1518 lines, then from 849 lines to 59 lines *) -(* coqc version 8.5 (January 2016) compiled on Jan 22 2016 18:20:47 with OCaml 4.02.3 - coqtop version r-schnelltop:/home/r/src/coq/coq,(HEAD detached at V8.5) (5e23fb90b39dfa014ae5c4fb46eb713cca09dbff) *) -Require Coq.Setoids.Setoid. -Import Coq.Setoids.Setoid. - -Class Equiv A := equiv: relation A. -Infix "≡" := equiv (at level 70, no associativity). -Notation "(≡)" := equiv (only parsing). - -(* If I remove this line, everything compiles. *) -Set Primitive Projections. - -Class Dist A := dist : nat -> relation A. -Notation "x ={ n }= y" := (dist n x y) - (at level 70, n at next level, format "x ={ n }= y"). - -Record CofeMixin A `{Equiv A, Dist A} := { - mixin_equiv_dist x y : x ≡ y <-> forall n, x ={n}= y; - mixin_dist_equivalence n : Equivalence (dist n); -}. - -Structure cofeT := CofeT { - cofe_car :> Type; - cofe_equiv : Equiv cofe_car; - cofe_dist : Dist cofe_car; - cofe_mixin : CofeMixin cofe_car -}. -Existing Instances cofe_equiv cofe_dist. -Arguments cofe_car : simpl never. - -Section cofe_mixin. - Context {A : cofeT}. - Implicit Types x y : A. - Lemma equiv_dist x y : x ≡ y <-> forall n, x ={n}= y. -Admitted. -End cofe_mixin. - Context {A : cofeT}. - Global Instance cofe_equivalence : Equivalence ((≡) : relation A). - Proof. - split. - * - intros x. -apply equiv_dist. - diff --git a/test-suite/bugs/closed/4533.v b/test-suite/bugs/closed/4533.v deleted file mode 100644 index fd2380a070..0000000000 --- a/test-suite/bugs/closed/4533.v +++ /dev/null @@ -1,230 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_lex_wrong_rewrite_02") -*- *) -(* File reduced by coq-bug-finder from original input, then from 1125 lines to -346 lines, then from 360 lines to 346 lines, then from 822 lines to 271 lines, -then from 285 lines to 271 lines *) -(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml -4.01.0 - coqtop version 8.5 (January 2016) *) -Declare ML Module "ltac_plugin". -Inductive False := . -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Coq.Init.Datatypes. -Import Coq.Init.Notations. -Global Set Universe Polymorphism. -Global Set Primitive Projections. -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Module Export Datatypes. - Set Implicit Arguments. - Notation nat := Coq.Init.Datatypes.nat. - Notation O := Coq.Init.Datatypes.O. - Notation S := Coq.Init.Datatypes.S. - Notation one := (S O). - Notation two := (S one). - Record prod (A B : Type) := pair { fst : A ; snd : B }. - Notation "x * y" := (prod x y) : type_scope. - Delimit Scope nat_scope with nat. - Open Scope nat_scope. -End Datatypes. -Module Export Specif. - Set Implicit Arguments. - Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P -proj1_sig }. - Notation sigT := sig (only parsing). - Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. - Notation projT1 := proj1_sig (only parsing). - Notation projT2 := proj2_sig (only parsing). -End Specif. -Global Set Keyed Unification. -Global Unset Strict Universe Declaration. -Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. -Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in -Type@{i}. -Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in - let ge := ((fun x => x) : Type1@{j} -> -Type@{i}) in Type@{i}. -Notation idmap := (fun x => x). -Delimit Scope function_scope with function. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Open Scope fibration_scope. -Open Scope function_scope. -Notation pr1 := projT1. -Notation pr2 := projT2. -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. -Notation compose := (fun g f x => g (f x)). -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left -associativity) : function_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. -Notation "1" := idpath : path_scope. -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : -type_scope. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr -(f x) = ap f (eissect x) - }. -Arguments eissect {A B}%type_scope f%function_scope {_} _. -Inductive Unit : Type1 := tt : Unit. -Local Open Scope path_scope. -Definition concat_p_pp {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z -= t) : - p @ (q @ r) = (p @ q) @ r := - match r with idpath => - match q with idpath => - match p with idpath => 1 - end end end. -Section Adjointify. - Context {A B : Type} (f : A -> B) (g : B -> A). - Context (isretr : Sect g f) (issect : Sect f g). - Let issect' := fun x => - ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. - - Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). - admit. - Defined. - - Definition isequiv_adjointify : IsEquiv f - := BuildIsEquiv A B f g isretr issect' is_adjoint'. -End Adjointify. -Definition ExtensionAlong {A B : Type} (f : A -> B) - (P : B -> Type) (d : forall x:A, P (f x)) - := { s : forall y:B, P y & forall x:A, s (f x) = d x }. -Fixpoint ExtendableAlong@{i j k l} - (n : nat) {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := match n with - | O => Unit@{l} - | S n => (forall (g : forall a, C (f a)), - ExtensionAlong@{i j k l l} f C g) * - forall (h k : forall b, C b), - ExtendableAlong n f (fun b => h b = k b) - end. - -Definition ooExtendableAlong@{i j k l} - {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := forall n, ExtendableAlong@{i j k l} n f C. - -Module Type ReflectiveSubuniverses. - - Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. - - Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : -Type@{i}), - In@{u a i} O (O_reflector@{u a i} O T). - - Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : -Type@{i}), - T -> O_reflector@{u a i} O T. - - Parameter extendable_to_O@{u a i j k} - : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : -Type2le@{j a}} {Q_inO : In@{u a j} O Q}, - ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). - -End ReflectiveSubuniverses. - -Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). - Export Os. - Existing Class In. - Module Export Coercions. - Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. - End Coercions. - Global Existing Instance O_inO. - - Section ORecursion. - Context {O : ReflectiveSubuniverse}. - - Definition O_rec {P Q : Type} {Q_inO : In O Q} - (f : P -> Q) - : O P -> Q - := (fst (extendable_to_O O one) f).1. - - Definition O_rec_beta {P Q : Type} {Q_inO : In O Q} - (f : P -> Q) (x : P) - : O_rec f (to O P x) = f x - := (fst (extendable_to_O O one) f).2 x. - - Definition O_indpaths {P Q : Type} {Q_inO : In O Q} - (g h : O P -> Q) (p : g o to O P == h o to O P) - : g == h - := (fst (snd (extendable_to_O O two) g h) p).1. - - End ORecursion. - - - Section Reflective_Subuniverse. - Context (O : ReflectiveSubuniverse@{Ou Oa}). - - Definition isequiv_to_O_inO@{u a i} (T : Type@{i}) `{In@{u a i} O T} : -IsEquiv@{i i} (to O T). - Proof. - - pose (g := O_rec@{u a i i i i i} idmap). - refine (isequiv_adjointify (to O T) g _ _). - - - refine (O_indpaths@{u a i i i i i} (to O T o g) idmap _). - intros x. - apply ap. - apply O_rec_beta. - - - intros x. - apply O_rec_beta. - Defined. - Global Existing Instance isequiv_to_O_inO. - - End Reflective_Subuniverse. - -End ReflectiveSubuniverses_Theory. - -Module Type Preserves_Fibers (Os : ReflectiveSubuniverses). - Module Export Os_Theory := ReflectiveSubuniverses_Theory Os. -End Preserves_Fibers. - -Opaque eissect. -Module Lex_Reflective_Subuniverses - (Os : ReflectiveSubuniverses) (Opf : Preserves_Fibers Os). - Import Opf. - Goal forall (O : ReflectiveSubuniverse) (A : Type) (B : A -> Type) (A_inO : -In O A), - - forall g, - forall (x : O {x : A & B x}) v v' v'' (p2 : v'' = v') (p0 : v' = v) (p1 : -v = _) r, - (p2 - @ (p0 - @ p1)) - @ eissect (to O A) (g x) = r. - intros. - cbv zeta. - rewrite concat_p_pp. - match goal with - | [ |- p2 @ p0 @ p1 @ eissect (to O A) (g x) = r ] => idtac "good" - | [ |- ?G ] => fail 1 "bad" G - end. - Fail rewrite concat_p_pp. diff --git a/test-suite/bugs/closed/4538.v b/test-suite/bugs/closed/4538.v deleted file mode 100644 index f925aae9e5..0000000000 --- a/test-suite/bugs/closed/4538.v +++ /dev/null @@ -1 +0,0 @@ -Reserved Notation " (u *) ". diff --git a/test-suite/bugs/closed/4544.v b/test-suite/bugs/closed/4544.v deleted file mode 100644 index 13c47edc8f..0000000000 --- a/test-suite/bugs/closed/4544.v +++ /dev/null @@ -1,1009 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_oog_looping_rewrite_01") -*- *) -(* File reduced by coq-bug-finder from original input, then from 2553 lines to 1932 lines, then from 1946 lines to 1932 lines, then from 2467 lines to 1002 lines, then from 1016 lines to 1002 lines *) -(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml 4.01.0 - coqtop version 8.5 (January 2016) *) -Declare ML Module "ltac_plugin". -Inductive False := . -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Coq.Init.Datatypes. - -Import Coq.Init.Notations. - -Global Set Universe Polymorphism. - -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Global Set Primitive Projections. - -Inductive sum (A B : Type) : Type := - | inl : A -> sum A B - | inr : B -> sum A B. -Notation nat := Coq.Init.Datatypes.nat. -Notation O := Coq.Init.Datatypes.O. -Notation S := Coq.Init.Datatypes.S. -Notation "x + y" := (sum x y) : type_scope. - -Record prod (A B : Type) := pair { fst : A ; snd : B }. - -Notation "x * y" := (prod x y) : type_scope. -Module Export Specif. - -Set Implicit Arguments. - -Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. -Arguments proj1_sig {A P} _ / . - -Notation sigT := sig (only parsing). -Notation existT := exist (only parsing). - -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. - -Notation projT1 := proj1_sig (only parsing). -Notation projT2 := proj2_sig (only parsing). - -End Specif. -Module Export HoTT_DOT_Basics_DOT_Overture. -Module Export HoTT. -Module Export Basics. -Module Export Overture. - -Global Set Keyed Unification. - -Global Unset Strict Universe Declaration. - -Notation Type0 := Set. - -Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. - -Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in Type@{i}. - -Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in - let ge := ((fun x => x) : Type1@{j} -> Type@{i}) in Type@{i}. - -Notation idmap := (fun x => x). -Delimit Scope function_scope with function. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Delimit Scope trunc_scope with trunc. - -Open Scope trunc_scope. -Open Scope path_scope. -Open Scope fibration_scope. -Open Scope nat_scope. -Open Scope function_scope. - -Notation "( x ; y )" := (existT _ x y) : fibration_scope. - -Notation pr1 := projT1. -Notation pr2 := projT2. - -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Notation "1" := idpath : path_scope. - -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. - -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. - -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. - -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) -}. - -Arguments eisretr {A B}%type_scope f%function_scope {_} _. - -Record Equiv A B := BuildEquiv { - equiv_fun : A -> B ; - equiv_isequiv : IsEquiv equiv_fun -}. - -Coercion equiv_fun : Equiv >-> Funclass. - -Global Existing Instance equiv_isequiv. - -Notation "A <~> B" := (Equiv A B) (at level 85) : type_scope. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) -}. - -Arguments center A {_}. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. -Notation "-2" := minus_two (at level 0) : trunc_scope. -Notation "-1" := (-2.+1) (at level 0) : trunc_scope. -Notation "0" := (-1.+1) : trunc_scope. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | -2 => Contr_internal A - | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Global Instance istrunc_paths (A : Type) n `{H : IsTrunc n.+1 A} (x y : A) -: IsTrunc n (x = y) - := H x y. - -Notation Contr := (IsTrunc -2). -Notation IsHProp := (IsTrunc -1). - -Hint Extern 0 => progress change Contr_internal with Contr in * : typeclass_instances. - -Monomorphic Axiom dummy_funext_type : Type0. -Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. - -Inductive Unit : Type1 := - tt : Unit. - -Class IsPointed (A : Type) := point : A. - -Arguments point A {_}. - -Record pType := - { pointed_type : Type ; - ispointed_type : IsPointed pointed_type }. - -Coercion pointed_type : pType >-> Sortclass. - -Global Existing Instance ispointed_type. - -Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. - -Ltac revert_opaque x := - revert x; - match goal with - | [ |- forall _, _ ] => idtac - | _ => fail 1 "Reverted constant is not an opaque variable" - end. - -End Overture. - -End Basics. - -End HoTT. - -End HoTT_DOT_Basics_DOT_Overture. -Module Export HoTT_DOT_Basics_DOT_PathGroupoids. -Module Export HoTT. -Module Export Basics. -Module Export PathGroupoids. - -Local Open Scope path_scope. - -Definition concat_p1 {A : Type} {x y : A} (p : x = y) : - p @ 1 = p - := - match p with idpath => 1 end. - -Definition concat_1p {A : Type} {x y : A} (p : x = y) : - 1 @ p = p - := - match p with idpath => 1 end. - -Definition concat_p_pp {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z = t) : - p @ (q @ r) = (p @ q) @ r := - match r with idpath => - match q with idpath => - match p with idpath => 1 - end end end. - -Definition concat_pp_p {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z = t) : - (p @ q) @ r = p @ (q @ r) := - match r with idpath => - match q with idpath => - match p with idpath => 1 - end end end. - -Definition concat_pV {A : Type} {x y : A} (p : x = y) : - p @ p^ = 1 - := - match p with idpath => 1 end. - -Definition moveR_Vp {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : x = y) : - p = r @ q -> r^ @ p = q. -admit. -Defined. - -Definition moveL_Vp {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : x = y) : - r @ q = p -> q = r^ @ p. -admit. -Defined. - -Definition moveR_M1 {A : Type} {x y : A} (p q : x = y) : - 1 = p^ @ q -> p = q. -admit. -Defined. - -Definition ap_pp {A B : Type} (f : A -> B) {x y z : A} (p : x = y) (q : y = z) : - ap f (p @ q) = (ap f p) @ (ap f q) - := - match q with - idpath => - match p with idpath => 1 end - end. - -Definition ap_V {A B : Type} (f : A -> B) {x y : A} (p : x = y) : - ap f (p^) = (ap f p)^ - := - match p with idpath => 1 end. - -Definition ap_compose {A B C : Type} (f : A -> B) (g : B -> C) {x y : A} (p : x = y) : - ap (g o f) p = ap g (ap f p) - := - match p with idpath => 1 end. - -Definition concat_pA1 {A : Type} {f : A -> A} (p : forall x, x = f x) {x y : A} (q : x = y) : - (p x) @ (ap f q) = q @ (p y) - := - match q as i in (_ = y) return (p x @ ap f i = i @ p y) with - | idpath => concat_p1 _ @ (concat_1p _)^ - end. - -End PathGroupoids. - -End Basics. - -End HoTT. - -End HoTT_DOT_Basics_DOT_PathGroupoids. -Module Export HoTT_DOT_Basics_DOT_Equivalences. -Module Export HoTT. -Module Export Basics. -Module Export Equivalences. - -Definition isequiv_commsq {A B C D} - (f : A -> B) (g : C -> D) (h : A -> C) (k : B -> D) - (p : k o f == g o h) - `{IsEquiv _ _ f} `{IsEquiv _ _ h} `{IsEquiv _ _ k} -: IsEquiv g. -admit. -Defined. - -Section Adjointify. - - Context {A B : Type} (f : A -> B) (g : B -> A). - Context (isretr : Sect g f) (issect : Sect f g). - - Let issect' := fun x => - ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. - - Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). - Proof. - unfold issect'. - apply moveR_M1. - repeat rewrite ap_pp, concat_p_pp; rewrite <- ap_compose. - rewrite (concat_pA1 (fun b => (isretr b)^) (ap f (issect a)^)). - repeat rewrite concat_pp_p; rewrite ap_V; apply moveL_Vp; rewrite concat_p1. - rewrite concat_p_pp, <- ap_compose. - rewrite (concat_pA1 (fun b => (isretr b)^) (isretr (f a))). - rewrite concat_pV, concat_1p; reflexivity. - Qed. - - Definition isequiv_adjointify : IsEquiv f - := BuildIsEquiv A B f g isretr issect' is_adjoint'. - -End Adjointify. - -End Equivalences. - -End Basics. - -End HoTT. - -End HoTT_DOT_Basics_DOT_Equivalences. -Module Export HoTT_DOT_Basics_DOT_Trunc. -Module Export HoTT. -Module Export Basics. -Module Export Trunc. -Generalizable Variables A B m n f. - -Definition trunc_equiv A {B} (f : A -> B) - `{IsTrunc n A} `{IsEquiv A B f} - : IsTrunc n B. -admit. -Defined. - -Record TruncType (n : trunc_index) := BuildTruncType { - trunctype_type : Type ; - istrunc_trunctype_type : IsTrunc n trunctype_type -}. - -Arguments BuildTruncType _ _ {_}. - -Coercion trunctype_type : TruncType >-> Sortclass. - -Notation "n -Type" := (TruncType n) (at level 1) : type_scope. -Notation hProp := (-1)-Type. - -Notation BuildhProp := (BuildTruncType -1). - -End Trunc. - -End Basics. - -End HoTT. - -End HoTT_DOT_Basics_DOT_Trunc. -Module Export HoTT_DOT_Types_DOT_Unit. -Module Export HoTT. -Module Export Types. -Module Export Unit. - -Notation unit_name x := (fun (_ : Unit) => x). - -End Unit. - -End Types. - -End HoTT. - -End HoTT_DOT_Types_DOT_Unit. -Module Export HoTT_DOT_Types_DOT_Sigma. -Module Export HoTT. -Module Export Types. -Module Export Sigma. -Local Open Scope path_scope. - -Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (pq : {p : u.1 = v.1 & p # u.2 = v.2}) -: u = v - := match pq.2 in (_ = v2) return u = (v.1; v2) with - | 1 => match pq.1 as p in (_ = v1) return u = (v1; p # u.2) with - | 1 => 1 - end - end. - -Definition path_sigma {A : Type} (P : A -> Type) (u v : sigT P) - (p : u.1 = v.1) (q : p # u.2 = v.2) -: u = v - := path_sigma_uncurried P u v (p;q). - -Definition path_sigma' {A : Type} (P : A -> Type) {x x' : A} {y : P x} {y' : P x'} - (p : x = x') (q : p # y = y') -: (x;y) = (x';y') - := path_sigma P (x;y) (x';y') p q. - -Global Instance isequiv_pr1_contr {A} {P : A -> Type} - `{forall a, Contr (P a)} -: IsEquiv (@pr1 A P) | 100. -Proof. - refine (isequiv_adjointify (@pr1 A P) - (fun a => (a ; center (P a))) _ _). - - - intros a; reflexivity. - - - intros [a p]. - refine (path_sigma' P 1 (contr _)). -Defined. - -Definition path_sigma_hprop {A : Type} {P : A -> Type} - `{forall x, IsHProp (P x)} - (u v : sigT P) -: u.1 = v.1 -> u = v - := path_sigma_uncurried P u v o pr1^-1. - -End Sigma. - -End Types. - -End HoTT. - -End HoTT_DOT_Types_DOT_Sigma. -Module Export HoTT_DOT_Extensions. -Module Export HoTT. -Module Export Extensions. - -Section Extensions. - - Definition ExtensionAlong {A B : Type} (f : A -> B) - (P : B -> Type) (d : forall x:A, P (f x)) - := { s : forall y:B, P y & forall x:A, s (f x) = d x }. - - Fixpoint ExtendableAlong@{i j k l} - (n : nat) {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := match n with - | O => Unit@{l} - | S n => (forall (g : forall a, C (f a)), - ExtensionAlong@{i j k l l} f C g) * - forall (h k : forall b, C b), - ExtendableAlong n f (fun b => h b = k b) - end. - - Definition ooExtendableAlong@{i j k l} - {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := forall n, ExtendableAlong@{i j k l} n f C. - -End Extensions. - -End Extensions. - -End HoTT. - -End HoTT_DOT_Extensions. -Module Export HoTT. -Module Export Modalities. -Module Export ReflectiveSubuniverse. - -Module Type ReflectiveSubuniverses. - - Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. - - Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), - In@{u a i} O (O_reflector@{u a i} O T). - - Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), - T -> O_reflector@{u a i} O T. - - Parameter inO_equiv_inO@{u a i j k} : - forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) - (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), - - let gei := ((fun x => x) : Type@{i} -> Type@{k}) in - let gej := ((fun x => x) : Type@{j} -> Type@{k}) in - In@{u a j} O U. - - Parameter hprop_inO@{u a i} - : Funext -> forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), - IsHProp (In@{u a i} O T). - - Parameter extendable_to_O@{u a i j k} - : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : Type2le@{j a}} {Q_inO : In@{u a j} O Q}, - ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). - -End ReflectiveSubuniverses. - -Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). -Export Os. - -Module Export Coercions. - - Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. - -End Coercions. - -End ReflectiveSubuniverses_Theory. - -Module Type ReflectiveSubuniverses_Restriction_Data (Os : ReflectiveSubuniverses). - - Parameter New_ReflectiveSubuniverse@{u a} : Type2@{u a}. - - Parameter ReflectiveSubuniverses_restriction@{u a} - : New_ReflectiveSubuniverse@{u a} -> Os.ReflectiveSubuniverse@{u a}. - -End ReflectiveSubuniverses_Restriction_Data. - -Module ReflectiveSubuniverses_Restriction - (Os : ReflectiveSubuniverses) - (Res : ReflectiveSubuniverses_Restriction_Data Os) -<: ReflectiveSubuniverses. - - Definition ReflectiveSubuniverse := Res.New_ReflectiveSubuniverse. - - Definition O_reflector@{u a i} (O : ReflectiveSubuniverse@{u a}) - := Os.O_reflector@{u a i} (Res.ReflectiveSubuniverses_restriction O). - Definition In@{u a i} (O : ReflectiveSubuniverse@{u a}) - := Os.In@{u a i} (Res.ReflectiveSubuniverses_restriction O). - Definition O_inO@{u a i} (O : ReflectiveSubuniverse@{u a}) - := Os.O_inO@{u a i} (Res.ReflectiveSubuniverses_restriction O). - Definition to@{u a i} (O : ReflectiveSubuniverse@{u a}) - := Os.to@{u a i} (Res.ReflectiveSubuniverses_restriction O). - Definition inO_equiv_inO@{u a i j k} (O : ReflectiveSubuniverse@{u a}) - := Os.inO_equiv_inO@{u a i j k} (Res.ReflectiveSubuniverses_restriction O). - Definition hprop_inO@{u a i} (H : Funext) (O : ReflectiveSubuniverse@{u a}) - := Os.hprop_inO@{u a i} H (Res.ReflectiveSubuniverses_restriction O). - Definition extendable_to_O@{u a i j k} (O : ReflectiveSubuniverse@{u a}) - := @Os.extendable_to_O@{u a i j k} (Res.ReflectiveSubuniverses_restriction@{u a} O). - -End ReflectiveSubuniverses_Restriction. - -Module ReflectiveSubuniverses_FamUnion - (Os1 Os2 : ReflectiveSubuniverses) -<: ReflectiveSubuniverses. - - Definition ReflectiveSubuniverse@{u a} : Type2@{u a} - := Os1.ReflectiveSubuniverse@{u a} + Os2.ReflectiveSubuniverse@{u a}. - - Definition O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. -admit. -Defined. - - Definition In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - Proof. - intros [O|O]; [ exact (Os1.In@{u a i} O) - | exact (Os2.In@{u a i} O) ]. - Defined. - - Definition O_inO@{u a i} - : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), - In@{u a i} O (O_reflector@{u a i} O T). -admit. -Defined. - - Definition to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), - T -> O_reflector@{u a i} O T. -admit. -Defined. - - Definition inO_equiv_inO@{u a i j k} : - forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) - (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), - In@{u a j} O U. - Proof. - intros [O|O]; [ exact (Os1.inO_equiv_inO@{u a i j k} O) - | exact (Os2.inO_equiv_inO@{u a i j k} O) ]. - Defined. - - Definition hprop_inO@{u a i} - : Funext -> forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), - IsHProp (In@{u a i} O T). -admit. -Defined. - - Definition extendable_to_O@{u a i j k} - : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : Type2le@{j a}} {Q_inO : In@{u a j} O Q}, - ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). -admit. -Defined. - -End ReflectiveSubuniverses_FamUnion. - -End ReflectiveSubuniverse. - -End Modalities. - -End HoTT. - -Module Type Modalities. - - Parameter Modality@{u a} : Type2@{u a}. - - Parameter O_reflector@{u a i} : forall (O : Modality@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter In@{u a i} : forall (O : Modality@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter O_inO@{u a i} : forall (O : Modality@{u a}) (T : Type@{i}), - In@{u a i} O (O_reflector@{u a i} O T). - - Parameter to@{u a i} : forall (O : Modality@{u a}) (T : Type@{i}), - T -> O_reflector@{u a i} O T. - - Parameter inO_equiv_inO@{u a i j k} : - forall (O : Modality@{u a}) (T : Type@{i}) (U : Type@{j}) - (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), - - let gei := ((fun x => x) : Type@{i} -> Type@{k}) in - let gej := ((fun x => x) : Type@{j} -> Type@{k}) in - In@{u a j} O U. - - Parameter hprop_inO@{u a i} - : Funext -> forall (O : Modality@{u a}) (T : Type@{i}), - IsHProp (In@{u a i} O T). - -End Modalities. - -Module Modalities_to_ReflectiveSubuniverses - (Os : Modalities) <: ReflectiveSubuniverses. - - Import Os. - - Fixpoint O_extendable@{u a i j k} (O : Modality@{u a}) - (A : Type@{i}) (B : O_reflector O A -> Type@{j}) - (B_inO : forall a, In@{u a j} O (B a)) (n : nat) - : ExtendableAlong@{i i j k} n (to O A) B. -admit. -Defined. - - Definition ReflectiveSubuniverse := Modality. - - Definition O_reflector@{u a i} := O_reflector@{u a i}. - - Definition In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a} - := In@{u a i}. - Definition O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), - In@{u a i} O (O_reflector@{u a i} O T) - := O_inO@{u a i}. - Definition to@{u a i} := to@{u a i}. - Definition inO_equiv_inO@{u a i j k} : - forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) - (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), - In@{u a j} O U - := inO_equiv_inO@{u a i j k}. - Definition hprop_inO@{u a i} - : Funext -> forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), - IsHProp (In@{u a i} O T) - := hprop_inO@{u a i}. - - Definition extendable_to_O@{u a i j k} (O : ReflectiveSubuniverse@{u a}) - {P : Type2le@{i a}} {Q : Type2le@{j a}} {Q_inO : In@{u a j} O Q} - : ooExtendableAlong@{i i j k} (to O P) (fun _ => Q) - := fun n => O_extendable O P (fun _ => Q) (fun _ => Q_inO) n. - -End Modalities_to_ReflectiveSubuniverses. - -Module Type EasyModalities. - - Parameter Modality@{u a} : Type2@{u a}. - - Parameter O_reflector@{u a i} : forall (O : Modality@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter to@{u a i} : forall (O : Modality@{u a}) (T : Type@{i}), - T -> O_reflector@{u a i} O T. - - Parameter minO_pathsO@{u a i} - : forall (O : Modality@{u a}) (A : Type@{i}) - (z z' : O_reflector@{u a i} O A), - IsEquiv (to@{u a i} O (z = z')). - -End EasyModalities. - -Module EasyModalities_to_Modalities (Os : EasyModalities) -<: Modalities. - - Import Os. - - Definition Modality := Modality. - - Definition O_reflector@{u a i} := O_reflector@{u a i}. - Definition to@{u a i} := to@{u a i}. - - Definition In@{u a i} - : forall (O : Modality@{u a}), Type@{i} -> Type@{i} - := fun O A => IsEquiv@{i i} (to O A). - - Definition hprop_inO@{u a i} `{Funext} (O : Modality@{u a}) - (T : Type@{i}) - : IsHProp (In@{u a i} O T). -admit. -Defined. - - Definition O_ind_internal@{u a i j k} (O : Modality@{u a}) - (A : Type@{i}) (B : O_reflector@{u a i} O A -> Type@{j}) - (B_inO : forall oa, In@{u a j} O (B oa)) - : let gei := ((fun x => x) : Type@{i} -> Type@{k}) in - let gej := ((fun x => x) : Type@{j} -> Type@{k}) in - (forall a, B (to O A a)) -> forall oa, B oa. -admit. -Defined. - - Definition O_ind_beta_internal@{u a i j k} (O : Modality@{u a}) - (A : Type@{i}) (B : O_reflector@{u a i} O A -> Type@{j}) - (B_inO : forall oa, In@{u a j} O (B oa)) - (f : forall a : A, B (to O A a)) (a:A) - : O_ind_internal@{u a i j k} O A B B_inO f (to O A a) = f a. -admit. -Defined. - - Definition O_inO@{u a i} (O : Modality@{u a}) (A : Type@{i}) - : In@{u a i} O (O_reflector@{u a i} O A). -admit. -Defined. - - Definition inO_equiv_inO@{u a i j k} (O : Modality@{u a}) (A : Type@{i}) (B : Type@{j}) - (A_inO : In@{u a i} O A) (f : A -> B) (feq : IsEquiv f) - : In@{u a j} O B. - Proof. - simple refine (isequiv_commsq (to O A) (to O B) f - (O_ind_internal O A (fun _ => O_reflector O B) _ (fun a => to O B (f a))) _). - - - intros; apply O_inO. - - - intros a; refine (O_ind_beta_internal@{u a i j k} O A (fun _ => O_reflector O B) _ _ a). - - - apply A_inO. - - - simple refine (isequiv_adjointify _ - (O_ind_internal O B (fun _ => O_reflector O A) _ (fun b => to O A (f^-1 b))) _ _); - intros x. - + - apply O_inO. - + - pattern x; refine (O_ind_internal O B _ _ _ x); intros. - * - apply minO_pathsO. - * - simpl; admit. - + - pattern x; refine (O_ind_internal O A _ _ _ x); intros. - * - apply minO_pathsO. - * - simpl; admit. - Defined. - -End EasyModalities_to_Modalities. - -Module Modalities_Theory (Os : Modalities). - -Export Os. -Module Export Os_ReflectiveSubuniverses - := Modalities_to_ReflectiveSubuniverses Os. -Module Export RSU - := ReflectiveSubuniverses_Theory Os_ReflectiveSubuniverses. - -Module Export Coercions. - Coercion modality_to_reflective_subuniverse - := idmap : Modality -> ReflectiveSubuniverse. -End Coercions. - -Class IsConnected (O : Modality@{u a}) (A : Type@{i}) - - := isconnected_contr_O : IsTrunc@{i} -2 (O A). - -Class IsConnMap (O : Modality@{u a}) - {A : Type@{i}} {B : Type@{j}} (f : A -> B) - := isconnected_hfiber_conn_map - - : forall b:B, IsConnected@{u a k} O (hfiber@{i j} f b). - -End Modalities_Theory. - -Private Inductive Trunc (n : trunc_index) (A :Type) : Type := - tr : A -> Trunc n A. -Arguments tr {n A} a. - -Global Instance istrunc_truncation (n : trunc_index) (A : Type@{i}) -: IsTrunc@{j} n (Trunc@{i} n A). -Admitted. - -Definition Trunc_ind {n A} - (P : Trunc n A -> Type) {Pt : forall aa, IsTrunc n (P aa)} - : (forall a, P (tr a)) -> (forall aa, P aa) -:= (fun f aa => match aa with tr a => fun _ => f a end Pt). - -Definition Truncation_Modality := trunc_index. - -Module Truncation_Modalities <: Modalities. - - Definition Modality : Type2@{u a} := Truncation_Modality. - - Definition O_reflector (n : Modality@{u u'}) A := Trunc n A. - - Definition In (n : Modality@{u u'}) A := IsTrunc n A. - - Definition O_inO (n : Modality@{u u'}) A : In n (O_reflector n A). -admit. -Defined. - - Definition to (n : Modality@{u u'}) A := @tr n A. - - Definition inO_equiv_inO (n : Modality@{u u'}) - (A : Type@{i}) (B : Type@{j}) Atr f feq - : let gei := ((fun x => x) : Type@{i} -> Type@{k}) in - let gej := ((fun x => x) : Type@{j} -> Type@{k}) in - In n B - := @trunc_equiv A B f n Atr feq. - - Definition hprop_inO `{Funext} (n : Modality@{u u'}) A - : IsHProp (In n A). -admit. -Defined. - -End Truncation_Modalities. - -Module Import TrM := Modalities_Theory Truncation_Modalities. - -Definition merely (A : Type@{i}) : hProp := BuildhProp (Trunc -1 A). - -Notation IsSurjection := (IsConnMap -1). - -Definition BuildIsSurjection {A B} (f : A -> B) : - (forall b, merely (hfiber f b)) -> IsSurjection f. -admit. -Defined. - -Ltac strip_truncations := - - progress repeat match goal with - | [ T : _ |- _ ] - => revert_opaque T; - refine (@Trunc_ind _ _ _ _ _); - - []; - intro T - end. -Local Open Scope trunc_scope. - -Global Instance conn_pointed_type {n : trunc_index} {A : Type} (a0:A) - `{IsConnMap n _ _ (unit_name a0)} : IsConnected n.+1 A | 1000. -admit. -Defined. - -Definition loops (A : pType) : pType := - Build_pType (point A = point A) idpath. - -Record pMap (A B : pType) := - { pointed_fun : A -> B ; - point_eq : pointed_fun (point A) = point B }. - -Arguments point_eq {A B} f : rename. -Coercion pointed_fun : pMap >-> Funclass. - -Infix "->*" := pMap (at level 99) : pointed_scope. -Local Open Scope pointed_scope. - -Definition pmap_compose {A B C : pType} - (g : B ->* C) (f : A ->* B) -: A ->* C - := Build_pMap A C (g o f) - (ap g (point_eq f) @ point_eq g). - -Record pHomotopy {A B : pType} (f g : pMap A B) := - { pointed_htpy : f == g ; - point_htpy : pointed_htpy (point A) @ point_eq g = point_eq f }. -Arguments pointed_htpy {A B f g} p x. - -Infix "==*" := pHomotopy (at level 70, no associativity) : pointed_scope. - -Definition loops_functor {A B : pType} (f : A ->* B) -: (loops A) ->* (loops B). -Proof. - refine (Build_pMap (loops A) (loops B) - (fun p => (point_eq f)^ @ (ap f p @ point_eq f)) _). - apply moveR_Vp; simpl. - refine (concat_1p _ @ (concat_p1 _)^). -Defined. - -Definition loops_functor_compose {A B C : pType} - (g : B ->* C) (f : A ->* B) -: (loops_functor (pmap_compose g f)) - ==* (pmap_compose (loops_functor g) (loops_functor f)). -admit. -Defined. - -Local Open Scope path_scope. - -Record ooGroup := - { classifying_space : pType@{i} ; - isconn_classifying_space : IsConnected@{u a i} 0 classifying_space - }. - -Local Notation B := classifying_space. - -Definition group_type (G : ooGroup) : Type - := point (B G) = point (B G). - -Coercion group_type : ooGroup >-> Sortclass. - -Definition group_loops (X : pType) -: ooGroup. -Proof. - - pose (x0 := point X); - pose (BG := (Build_pType - { x:X & merely (x = point X) } - (existT (fun x:X => merely (x = point X)) x0 (tr 1)))). - - cut (IsConnected 0 BG). - { - exact (Build_ooGroup BG). -} - cut (IsSurjection (unit_name (point BG))). - { - intros; refine (conn_pointed_type (point _)). -} - apply BuildIsSurjection; simpl; intros [x p]. - strip_truncations; apply tr; exists tt. - apply path_sigma_hprop; simpl. - exact (p^). -Defined. - -Definition loops_group (X : pType) -: loops X <~> group_loops X. -admit. -Defined. - -Definition ooGroupHom (G H : ooGroup) - := pMap (B G) (B H). - -Definition grouphom_fun {G H} (phi : ooGroupHom G H) : G -> H - := loops_functor phi. - -Coercion grouphom_fun : ooGroupHom >-> Funclass. - -Definition group_loops_functor - {X Y : pType} (f : pMap X Y) -: ooGroupHom (group_loops X) (group_loops Y). -Proof. - simple refine (Build_pMap _ _ _ _); simpl. - - - intros [x p]. - exists (f x). - strip_truncations; apply tr. - exact (ap f p @ point_eq f). - - - apply path_sigma_hprop; simpl. - apply point_eq. -Defined. - -Definition loops_functor_group - {X Y : pType} (f : pMap X Y) -: loops_functor (group_loops_functor f) o loops_group X - == loops_group Y o loops_functor f. -admit. -Defined. - -Definition grouphom_compose {G H K : ooGroup} - (psi : ooGroupHom H K) (phi : ooGroupHom G H) -: ooGroupHom G K - := pmap_compose psi phi. - -Definition group_loops_functor_compose - {X Y Z : pType} - (psi : pMap Y Z) (phi : pMap X Y) -: grouphom_compose (group_loops_functor psi) (group_loops_functor phi) - == group_loops_functor (pmap_compose psi phi). -Proof. - intros g. - unfold grouphom_fun, grouphom_compose. - refine (pointed_htpy (loops_functor_compose _ _) g @ _). - pose (p := eisretr (loops_group X) g). - change (loops_functor (group_loops_functor psi) - (loops_functor (group_loops_functor phi) g) - = loops_functor (group_loops_functor - (pmap_compose psi phi)) g). - rewrite <- p. - Fail Timeout 1 Time rewrite !loops_functor_group. - (* 0.004 s in 8.5rc1, 8.677 s in 8.5 *) - Timeout 1 do 3 rewrite loops_functor_group. -Abort. diff --git a/test-suite/bugs/closed/4574.v b/test-suite/bugs/closed/4574.v deleted file mode 100644 index 39ba190369..0000000000 --- a/test-suite/bugs/closed/4574.v +++ /dev/null @@ -1,8 +0,0 @@ -Require Import Setoid. - -Definition block A (a : A) := a. - -Goal forall A (a : A), block Type nat. -Proof. -Fail reflexivity. - diff --git a/test-suite/bugs/closed/4576.v b/test-suite/bugs/closed/4576.v deleted file mode 100644 index 2c643ea779..0000000000 --- a/test-suite/bugs/closed/4576.v +++ /dev/null @@ -1,3 +0,0 @@ -Definition foo := O. -Arguments foo : simpl nomatch. -Timeout 1 Eval cbn in id foo. diff --git a/test-suite/bugs/closed/4580.v b/test-suite/bugs/closed/4580.v deleted file mode 100644 index 4ffd5f0f4b..0000000000 --- a/test-suite/bugs/closed/4580.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import Program. - -Class Foo (A : Type) := foo : A. - -Unset Refine Instance Mode. -Program Instance f1 : Foo nat := S _. diff --git a/test-suite/bugs/closed/4582.v b/test-suite/bugs/closed/4582.v deleted file mode 100644 index 0842fb8fa7..0000000000 --- a/test-suite/bugs/closed/4582.v +++ /dev/null @@ -1,10 +0,0 @@ -Require List. -Import List.ListNotations. - -Variable Foo : nat -> nat. - -Delimit Scope Foo_scope with F. - -Notation " [ x ] " := (Foo x) : Foo_scope. - -Check ([1] : nat)%F. diff --git a/test-suite/bugs/closed/4588.v b/test-suite/bugs/closed/4588.v deleted file mode 100644 index ff66277e03..0000000000 --- a/test-suite/bugs/closed/4588.v +++ /dev/null @@ -1,10 +0,0 @@ -Set Primitive Projections. - -(* This proof was accepted in Coq 8.5 because the subterm specs were not -projected correctly *) -Inductive foo : Prop := mkfoo { proj1 : False -> foo; proj2 : (forall P : Prop, P -> P) }. - -Fail Fixpoint loop (x : foo) : False := - loop (proj2 x _ x). - -Fail Definition bad : False := loop (mkfoo (fun x => match x with end) (fun _ x => x)). diff --git a/test-suite/bugs/closed/4596.v b/test-suite/bugs/closed/4596.v deleted file mode 100644 index 592fdb6580..0000000000 --- a/test-suite/bugs/closed/4596.v +++ /dev/null @@ -1,14 +0,0 @@ -Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. - -Definition T (x : bool) := x = true. - -Goal forall (S : Type) (b b0 : S -> nat -> bool) (str : S) (p : nat) - (s : forall n : nat, bool) - (s0 s1 : nat -> S -> S), - (forall (str0 : S) (n m : nat), - (if s m then T (b0 (s1 n str0) 0) else T (b (s1 n str0) 0)) -> T (b (s0 n str0) m) -> - T (b str0 m)) -> - T (b str p). -Proof. -intros ???????? H0. -rewrite H0. diff --git a/test-suite/bugs/closed/4603.v b/test-suite/bugs/closed/4603.v deleted file mode 100644 index 2c90044dc7..0000000000 --- a/test-suite/bugs/closed/4603.v +++ /dev/null @@ -1,10 +0,0 @@ -Axiom A : Type. - -Goal True. exact I. -Check (fun P => P A). -Abort. - -Goal True. -Definition foo (A : Type) : Prop:= True. - set (x:=foo). split. -Qed. diff --git a/test-suite/bugs/closed/4612.v b/test-suite/bugs/closed/4612.v deleted file mode 100644 index ce95f26acc..0000000000 --- a/test-suite/bugs/closed/4612.v +++ /dev/null @@ -1,7 +0,0 @@ -(* While waiting for support, check at least that it does not raise an anomaly *) - -Inductive ctype := -| Struct: list ctype -> ctype -| Bot : ctype. - -Fail Scheme Equality for ctype. diff --git a/test-suite/bugs/closed/4616.v b/test-suite/bugs/closed/4616.v deleted file mode 100644 index d6660e3553..0000000000 --- a/test-suite/bugs/closed/4616.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Coq.extraction.Extraction. - -Set Primitive Projections. -Record Foo' := Foo { foo : Type }. -Definition f := forall t : Foo', foo t. -Extraction f. -Extraction TestCompile f. diff --git a/test-suite/bugs/closed/4622.v b/test-suite/bugs/closed/4622.v deleted file mode 100644 index ffa478cb87..0000000000 --- a/test-suite/bugs/closed/4622.v +++ /dev/null @@ -1,24 +0,0 @@ -Set Primitive Projections. - -Record foo : Type := bar { x : unit }. - -Goal forall t u, bar t = bar u -> t = u. -Proof. - intros. - injection H. - trivial. -Qed. -(* Was: Error: Pattern-matching expression on an object of inductive type foo has invalid information. *) - -(** Dependent pattern-matching is ok on this one as it has eta *) -Definition baz (x : foo) := - match x as x' return x' = x' with - | bar u => eq_refl - end. - -Inductive foo' : Type := bar' {x' : unit; y: foo'}. -(** Dependent pattern-matching is not ok on this one *) -Fail Definition baz' (x : foo') := - match x as x' return x' = x' with - | bar' u y => eq_refl - end. diff --git a/test-suite/bugs/closed/4623.v b/test-suite/bugs/closed/4623.v deleted file mode 100644 index 7ecfd98b67..0000000000 --- a/test-suite/bugs/closed/4623.v +++ /dev/null @@ -1,5 +0,0 @@ -Goal Type -> Type. -set (T := Type). -clearbody T. -refine (@id _). -Qed. diff --git a/test-suite/bugs/closed/4624.v b/test-suite/bugs/closed/4624.v deleted file mode 100644 index f5ce981cd0..0000000000 --- a/test-suite/bugs/closed/4624.v +++ /dev/null @@ -1,7 +0,0 @@ -Record foo := mkfoo { type : Type }. - -Canonical Structure fooA (T : Type) := mkfoo (T -> T). - -Definition id (t : foo) (x : type t) := x. - -Definition bar := id _ ((fun x : nat => x) : _). diff --git a/test-suite/bugs/closed/4627.v b/test-suite/bugs/closed/4627.v deleted file mode 100644 index 4f56e19584..0000000000 --- a/test-suite/bugs/closed/4627.v +++ /dev/null @@ -1,49 +0,0 @@ -Class sa (A:Type) := { }. - -Record predicate A (sa:sa A) := - { pred_fun: A->Prop }. -Record ABC : Type := - { abc: Type }. -Record T := - { T_abc: ABC }. - - -(* -sa: forall _ : Type@{Top.179}, Prop -predicate: forall (A : Type@{Top.205}) (_ : sa A), Type@{max(Set+1, Top.205)} -T: Type@{Top.208+1} -ABC: Type@{Top.208+1} -abc: forall _ : ABC, Type@{Top.208} - -Top.205 <= Top.179 predicate <= sa.A -Set < Top.208 Set < abc -Set < Top.205 Set < predicate -*) - -Definition foo : predicate T (Build_sa T) := - {| pred_fun:= fun w => True |}. -(* *) -(* Top.208 < Top.205 <--- added by foo *) -(* *) - -Check predicate nat (Build_sa nat). -(* - -The issue is that the template polymorphic universe of [predicate], Top.205, does not get replaced with the universe of [nat] in the above line. - -Jason Gross - -8.5 -- predicate nat (Build_sa nat): Type@{max(Set+1, Top.205)} -8.5 EXPECTED -- predicate nat (Build_sa nat): Type@{Set+1} -8.4pl4 -- predicate nat {| |}: Type (* max(Set, (Set)+1) *) -*) - -(* This works in 8.4pl4 and SHOULD work in 8.5 *) -Definition bar : ABC := - {| abc:= predicate nat (Build_sa nat) |}. -(* -The term "predicate nat (Build_sa nat)" has type - "Type@{max(Set+1, Top.205)}" -while it is expected to have type "Type@{Top.208}" -(universe inconsistency: Cannot enforce Top.205 <= -Top.208 because Top.208 < Top.205). -*) diff --git a/test-suite/bugs/closed/4628.v b/test-suite/bugs/closed/4628.v deleted file mode 100644 index 7d4a15d689..0000000000 --- a/test-suite/bugs/closed/4628.v +++ /dev/null @@ -1,46 +0,0 @@ -Module first. - Polymorphic Record BAR (A:Type) := - { foo: A->Prop; bar: forall (x y: A), foo x -> foo y}. - -Section A. -Context {A:Type}. - -Set Printing Universes. - -Hint Resolve bar. -Goal forall (P:BAR A) x y, foo _ P x -> foo _ P y. -intros. -eauto. -Qed. -End A. -End first. - -Module firstbest. - Polymorphic Record BAR (A:Type) := - { foo: A->Prop; bar: forall (x y: A), foo x -> foo y}. - -Section A. -Context {A:Type}. - -Set Printing Universes. - -Polymorphic Hint Resolve bar. -Goal forall (P:BAR A) x y, foo _ P x -> foo _ P y. -intros. -eauto. -Qed. -End A. -End firstbest. - -Module second. -Axiom foo: Set. -Axiom foo': Set. - -Polymorphic Record BAR (A:Type) := - { bar: foo' -> foo}. -Set Printing Universes. - -Lemma baz@{i}: forall (P:BAR@{Set} nat), foo' -> foo. - eauto using bar. -Qed. -End second. diff --git a/test-suite/bugs/closed/4634.v b/test-suite/bugs/closed/4634.v deleted file mode 100644 index 77e31e108f..0000000000 --- a/test-suite/bugs/closed/4634.v +++ /dev/null @@ -1,16 +0,0 @@ -Set Primitive Projections. - -Polymorphic Record pair {A B : Type} : Type := - prod { pr1 : A; pr2 : B }. - -Notation " ( x ; y ) " := (@prod _ _ x y). -Notation " x .1 " := (pr1 x) (at level 3). -Notation " x .2 " := (pr2 x) (at level 3). - -Goal ((0; 1); 2).1.2 = 1. -Proof. - cbv. - match goal with - | |- ?t = ?t => exact (eq_refl t) - end. -Qed. diff --git a/test-suite/bugs/closed/4644.v b/test-suite/bugs/closed/4644.v deleted file mode 100644 index f09b27c2b1..0000000000 --- a/test-suite/bugs/closed/4644.v +++ /dev/null @@ -1,52 +0,0 @@ -(* Testing a regression of unification in 8.5 in problems of the form - "match ?y with ... end = ?x args" *) - -Lemma foo : exists b, forall a, match a with tt => tt end = b a. -Proof. -eexists. intro. -refine (_ : _ = match _ with tt => _ end). -refine eq_refl. -Qed. - -(**********************************************************************) - -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Export Coq.Classes.Morphisms. -Require Import Coq.Lists.List. - -Global Set Implicit Arguments. - -Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs)) - ls - : P ls - := match ls with - | nil => N - | x::xs => C x xs - end. - -Axiom list_caset_Proper' - : forall {A P}, - Proper (eq - ==> pointwise_relation _ (pointwise_relation _ eq) - ==> eq - ==> eq) - (@list_caset A (fun _ => P)). -Goal forall (T T' : Set) (a3 : list T), exists y2, forall (a4 : T' -> bool), - match a3 with - | nil => 0 - | (_ :: _)%list => 1 - end = y2 a4. - clear; eexists; intros. - reflexivity. Undo. - Local Ltac t := - lazymatch goal with - | [ |- match ?v with nil => ?N | cons x xs => @?C x xs end = _ :> ?P ] - => let T := type of v in - let A := match (eval hnf in T) with list ?A => A end in - refine (@list_caset_Proper' A P _ _ _ _ _ _ _ _ _ - : @list_caset A (fun _ => P) N C v = match _ with nil => _ | cons x xs => _ end) - end. - (etransitivity; [ t | reflexivity ]) || fail 0 "too early". - Undo. - t. diff --git a/test-suite/bugs/closed/4653.v b/test-suite/bugs/closed/4653.v deleted file mode 100644 index 4514342c5e..0000000000 --- a/test-suite/bugs/closed/4653.v +++ /dev/null @@ -1,3 +0,0 @@ -Definition T := Type. -Module Type S. Parameter foo : let A := T in True. End S. -Module M <: S. Lemma foo (A := T) : True. Proof I. End M. diff --git a/test-suite/bugs/closed/4661.v b/test-suite/bugs/closed/4661.v deleted file mode 100644 index 03d2350a69..0000000000 --- a/test-suite/bugs/closed/4661.v +++ /dev/null @@ -1,10 +0,0 @@ -Module Type Test. - Parameter t : Type. -End Test. - -Module Type Func (T:Test). - Parameter x : Type. -End Func. - -Module Shortest_path (T : Test). -Print Func. diff --git a/test-suite/bugs/closed/4663.v b/test-suite/bugs/closed/4663.v deleted file mode 100644 index b76619882a..0000000000 --- a/test-suite/bugs/closed/4663.v +++ /dev/null @@ -1,3 +0,0 @@ -Coercion foo (n : nat) : Set. -Admitted. -Check (0 : Set). diff --git a/test-suite/bugs/closed/4670.v b/test-suite/bugs/closed/4670.v deleted file mode 100644 index 6113992953..0000000000 --- a/test-suite/bugs/closed/4670.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Coq.Vectors.Vector. -Module Bar. - Definition foo A n (l : Vector.t A n) : True. - Proof. - induction l ; exact I. - Defined. -End Bar. diff --git a/test-suite/bugs/closed/4673.v b/test-suite/bugs/closed/4673.v deleted file mode 100644 index 10e48db6dd..0000000000 --- a/test-suite/bugs/closed/4673.v +++ /dev/null @@ -1,57 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerOptimized" "-R" "." "Top") -*- *) -(* File reduced by coq-bug-finder from original input, then from 2407 lines to 22 lines, then from 528 lines to 35 lines, then from 331 lines to 42 lines, then from 56 lines to 42 lines, then from 63 lines to 46 lines, then from 60 lines to 46 lines *) (* coqc version 8.5 (February 2016) compiled on Feb 21 2016 15:26:16 with OCaml 4.02.3 - coqtop version 8.5 (February 2016) *) -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Coq.Lists.List. -Import Coq.Lists.List. -Import Coq.Classes.Morphisms. - -Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs)) - ls - : P ls - := match ls with - | nil => N - | x::xs => C x xs - end. - -Global Instance list_caset_Proper' {A P} - : Proper (eq - ==> pointwise_relation _ (pointwise_relation _ eq) - ==> eq - ==> eq) - (@list_caset A (fun _ => P)). -admit. -Defined. - -Global Instance list_caset_Proper'' {A P} - : (Proper (eq ==> pointwise_relation _ (pointwise_relation _ eq) ==> forall_relation (fun _ => eq)) - (list_caset A (fun _ => P))). -Admitted. - -Goal forall (Char : Type) (P : forall _ : list bool, Prop) (l : list bool) (l0 : forall _ : forall _ : Char, bool, list bool) - - (T : Type) (T0 : forall _ : T, Type) (t : T), - - let predata := t in - - forall (splitdata : T0 predata) (l5 : forall _ : T0 t, list nat) (T1 : Type) (b : forall (_ : T1) (_ : Char), bool) - - (T2 : Type) (a11 : T2) (xs : list T2) (T3 : Type) (i0 : T3) (P0 : Set) (b1 : forall (_ : nat) (_ : P0), bool) - - (l2 : forall (_ : forall _ : T1, list bool) (_ : forall _ : P0, list bool) (_ : T2), list bool) - - (l1 : forall (_ : forall _ : forall _ : Char, bool, list bool) (_ : forall _ : P0, list bool) (_ : T3), list bool) - - (_ : forall NT : forall _ : P0, list bool, @eq (list bool) (l1 l0 NT i0) (l2 (fun f : T1 => l0 (b f)) NT a11)), - - P - (@list_caset T2 (fun _ : list T2 => list bool) l - (fun (_ : T2) (_ : list T2) => l1 l0 (fun a9 : P0 => @map nat bool (fun x0 : nat => b1 x0 a9) (l5 splitdata)) i0 -) xs). - intros. - subst predata; - let H := match goal with H : forall _, _ = _ |- _ => H end in - setoid_rewrite H || fail 0 "too early". - Undo. - setoid_rewrite H. diff --git a/test-suite/bugs/closed/4679.v b/test-suite/bugs/closed/4679.v deleted file mode 100644 index 3f41c5d6b1..0000000000 --- a/test-suite/bugs/closed/4679.v +++ /dev/null @@ -1,18 +0,0 @@ -Require Import Coq.Setoids.Setoid. -Goal forall (T : nat -> Set -> Set) (U : Set) - (H : forall n : nat, T n (match n with - | 0 => fun x => x - | S _ => fun x => x - end (nat = nat)) = U), - T 0 (nat = nat) = U. -Proof. - intros. - let H := match goal with H : forall _, eq _ _ |- _ => H end in - rewrite H || fail 0 "too early". - Undo. - let H := match goal with H : forall _, eq _ _ |- _ => H end in - setoid_rewrite (H 0) || fail 0 "too early". - Undo. - setoid_rewrite H. (* Error: Tactic failure: setoid rewrite failed: Nothing to rewrite. *) - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/4684.v b/test-suite/bugs/closed/4684.v deleted file mode 100644 index 9c0bed42c4..0000000000 --- a/test-suite/bugs/closed/4684.v +++ /dev/null @@ -1,32 +0,0 @@ -(*Suppose a user wants to declare a new list-like notation with support for singletons in both 8.4 and 8.5. If they use*) -Require Import Coq.Lists.List. -Require Import Coq.Vectors.Vector. -Import ListNotations. -Import VectorNotations. -Set Implicit Arguments. -Inductive mylist T := mynil | mycons (_ : T) (_ : mylist T). -Arguments mynil {_}, _. - -Delimit Scope mylist_scope with mylist. -Bind Scope mylist_scope with mylist. -Delimit Scope vector_scope with vector. - -Notation " [ ] " := mynil (format "[ ]") : mylist_scope. -Notation " [ x ] " := (mycons x mynil) : mylist_scope. -Notation " [ x ; y ; .. ; z ] " := (mycons x (mycons y .. (mycons z mynil) ..)) : mylist_scope. - -Check [ ]%mylist : mylist _. -Check [ ]%list : list _. -Check []%vector : Vector.t _ _. -Check [ _ ]%mylist : mylist _. -Check [ _ ]%list : list _. -Check [ _ ]%vector : Vector.t _ _. -Check [ _ ; _ ]%list : list _. -Check [ _ ; _ ]%vector : Vector.t _ _. -Check [ _ ; _ ]%mylist : mylist _. -Check [ _ ; _ ; _ ]%list : list _. -Check [ _ ; _ ; _ ]%vector : Vector.t _ _. -Check [ _ ; _ ; _ ]%mylist : mylist _. -Check [ _ ; _ ; _ ; _ ]%list : list _. -Check [ _ ; _ ; _ ; _ ]%vector : Vector.t _ _. -Check [ _ ; _ ; _ ; _ ]%mylist : mylist _. diff --git a/test-suite/bugs/closed/4695.v b/test-suite/bugs/closed/4695.v deleted file mode 100644 index a42271811d..0000000000 --- a/test-suite/bugs/closed/4695.v +++ /dev/null @@ -1,38 +0,0 @@ -(* -The Qed at the end of this file was slow in 8.5 and 8.5pl1 because the kernel -term comparison after evaluation was done on constants according to their user -names. The conversion still succeeded because delta applied, but was much -slower than with a canonical names comparison. -*) - -Module Mod0. - - Fixpoint rec_ t d : nat := - match d with - | O => O - | S d' => - match t with - | true => rec_ t d' - | false => rec_ t d' - end - end. - - Definition depth := 1000. - - Definition rec t := rec_ t depth. - -End Mod0. - - -Module Mod1. - Module M := Mod0. -End Mod1. - - -Axiom rec_prop : forall t d n, Mod1.M.rec_ t d = n. - -Lemma slow_qed : forall t n, - Mod0.rec t = n. -Proof. - intros; unfold Mod0.rec; apply rec_prop. -Timeout 2 Qed. diff --git a/test-suite/bugs/closed/4708.v b/test-suite/bugs/closed/4708.v deleted file mode 100644 index ad2e581004..0000000000 --- a/test-suite/bugs/closed/4708.v +++ /dev/null @@ -1,8 +0,0 @@ -(*Doc, it hurts when I poke myself.*) - -Notation "'" := 1. (* was: -Setting notation at level 0. -Toplevel input, characters 0-18: -> Notation "'" := 1. -> ^^^^^^^^^^^^^^^^^^ -Anomaly: Uncaught exception Invalid_argument("index out of bounds"). Please report. *) diff --git a/test-suite/bugs/closed/4709.v b/test-suite/bugs/closed/4709.v deleted file mode 100644 index a9edcc8043..0000000000 --- a/test-suite/bugs/closed/4709.v +++ /dev/null @@ -1,18 +0,0 @@ - -(** Bug 4709 https://coq.inria.fr/bug/4709 - Extraction wasn't reducing primitive projections in types. *) - -Require Extraction. - -Set Primitive Projections. - -Record t := Foo { foo : Type }. -Definition ty := foo (Foo nat). - -(* Without proper reduction of primitive projections in - [extract_type], the type [ty] was extracted as [Tunknown]. - Let's check it isn't the case anymore. *) - -Parameter check : nat. -Extract Constant check => "(O:ty)". -Extraction TestCompile ty check. diff --git a/test-suite/bugs/closed/4710.v b/test-suite/bugs/closed/4710.v deleted file mode 100644 index e792a36234..0000000000 --- a/test-suite/bugs/closed/4710.v +++ /dev/null @@ -1,15 +0,0 @@ -Require Coq.extraction.Extraction. - -Set Primitive Projections. -Record Foo' := Foo { foo : nat }. -Extraction foo. -Record Foo2 (a : nat) := Foo2c { foo2p : nat; foo2b : bool }. -Extraction foo2p. - -Definition bla (x : Foo2 0) := foo2p _ x. -Extraction bla. - -Definition bla' (a : nat) (x : Foo2 a) := foo2b _ x. -Extraction bla'. - -Extraction TestCompile foo foo2p bla bla'. diff --git a/test-suite/bugs/closed/4713.v b/test-suite/bugs/closed/4713.v deleted file mode 100644 index 5d4d73be3f..0000000000 --- a/test-suite/bugs/closed/4713.v +++ /dev/null @@ -1,10 +0,0 @@ -Module Type T. - Parameter t : Type. -End T. -Module M : T. - Definition t := unit. -End M. - -Fail Module Z : T with Module t := M := M. -Fail Module Z <: T with Module t := M := M. -Fail Declare Module Z : T with Module t := M. diff --git a/test-suite/bugs/closed/4717.v b/test-suite/bugs/closed/4717.v deleted file mode 100644 index bd9bac37ef..0000000000 --- a/test-suite/bugs/closed/4717.v +++ /dev/null @@ -1,33 +0,0 @@ -(* Omega being smarter on recognizing nat and Z *) - -Require Import Omega. - -Definition nat' := nat. - -Theorem le_not_eq_lt : forall (n m:nat), - n <= m -> - n <> m :> nat' -> - n < m. -Proof. - intros. - omega. -Qed. - -Goal forall (x n : nat'), x = x + n - n. -Proof. - intros. - omega. -Qed. - -Open Scope Z_scope. - -Definition Z' := Z. - -Theorem Zle_not_eq_lt : forall n m, - n <= m -> - n <> m :> Z' -> - n < m. -Proof. - intros. - omega. -Qed. diff --git a/test-suite/bugs/closed/4718.v b/test-suite/bugs/closed/4718.v deleted file mode 100644 index 12a4e8fc1a..0000000000 --- a/test-suite/bugs/closed/4718.v +++ /dev/null @@ -1,15 +0,0 @@ -(*Congruence is weaker than reflexivity when it comes to higher level than necessary equalities:*) - -Goal @eq Set nat nat. -congruence. -Qed. - -Goal @eq Type nat nat. -congruence. (*bug*) -Qed. - -Variable T : Type. - -Goal @eq Type T T. -congruence. -Qed. diff --git a/test-suite/bugs/closed/4720.v b/test-suite/bugs/closed/4720.v deleted file mode 100644 index 704331e784..0000000000 --- a/test-suite/bugs/closed/4720.v +++ /dev/null @@ -1,50 +0,0 @@ -(** Bug 4720 : extraction and "with" in module type *) - -Module Type A. - Parameter t : Set. -End A. - -Module A_instance <: A. - Definition t := nat. -End A_instance. - -Module A_private : A. - Definition t := nat. -End A_private. - -Module Type B. -End B. - -Module Type C (b : B). - Declare Module a : A. -End C. - -Module WithMod (a' : A) (b' : B) (c' : C b' with Module a := A_instance). -End WithMod. - -Module WithDef (a' : A) (b' : B) (c' : C b' with Definition a.t := nat). -End WithDef. - -Module WithModPriv (a' : A) (b' : B) (c' : C b' with Module a := A_private). -End WithModPriv. - -(* The initial bug report was concerning the extraction of WithModPriv - in Coq 8.4, which was suboptimal: it was compiling, but could have been - turned into some faulty code since A_private and c'.a were not seen as - identical by the extraction. - - In Coq 8.5 and 8.6, the extractions of WithMod, WithDef, WithModPriv - were all causing Anomaly or Assert Failure. This shoud be fixed now. -*) - -Require Extraction. - -Recursive Extraction WithMod. - -Recursive Extraction WithDef. - -Recursive Extraction WithModPriv. - -(* Let's even check that all this extracted code is actually compilable: *) - -Extraction TestCompile WithMod WithDef WithModPriv. diff --git a/test-suite/bugs/closed/4723.v b/test-suite/bugs/closed/4723.v deleted file mode 100644 index 5fb9696f3f..0000000000 --- a/test-suite/bugs/closed/4723.v +++ /dev/null @@ -1,28 +0,0 @@ - -Require Coq.Program.Tactics. - -Record Matrix (m n : nat). - -Definition kp {m n p q: nat} (A: Matrix m n) (B: Matrix p q): - Matrix (m*p) (n*q). Admitted. - -Fail Program Fact kp_assoc - (xr xc yr yc zr zc: nat) - (x: Matrix xr xc) (y: Matrix yr yc) (z: Matrix zr zc): - kp x (kp y z) = kp (kp x y) z. - -Ltac Obligation Tactic := admit. -Fail Program Fact kp_assoc - (xr xc yr yc zr zc: nat) - (x: Matrix xr xc) (y: Matrix yr yc) (z: Matrix zr zc): - kp x (kp y z) = kp (kp x y) z. - -Axiom cheat : forall {A}, A. -Obligation Tactic := apply cheat. - -Program Fact kp_assoc - (xr xc yr yc zr zc: nat) - (x: Matrix xr xc) (y: Matrix yr yc) (z: Matrix zr zc): - kp x (kp y z) = kp (kp x y) z. -admit. -Admitted. diff --git a/test-suite/bugs/closed/4725.v b/test-suite/bugs/closed/4725.v deleted file mode 100644 index fd5e0fb60d..0000000000 --- a/test-suite/bugs/closed/4725.v +++ /dev/null @@ -1,38 +0,0 @@ -Require Import EquivDec Equivalence List Program. -Require Import Relation_Definitions. -Import ListNotations. -Generalizable All Variables. - -Fixpoint removeV `{eqDecV : @EqDec V eqV equivV}`(x : V) (l : list V) : list V -:= - match l with - | nil => nil - | y::tl => if (equiv_dec x y) then removeV x tl else y::(removeV x tl) - end. - -Lemma remove_le {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV : -@EqDec V eqV equivV} (xs : list V) (x : V) : - length (removeV x xs) < length (x :: xs). - Proof. Admitted. - -(* Function version *) -Set Printing Universes. - -Require Import Recdef. - -Function nubV {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV : -@EqDec V eqV equivV} (l : list V) { measure length l} := - match l with - | nil => nil - | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs) - end. -Proof. intros. apply remove_le. Qed. - -(* Program version *) - -Program Fixpoint nubV `{eqDecV : @EqDec V eqV equivV} (l : list V) - { measure (@length V l) lt } := - match l with - | nil => nil - | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs) _ - end. diff --git a/test-suite/bugs/closed/4726.v b/test-suite/bugs/closed/4726.v deleted file mode 100644 index 0037b6fdea..0000000000 --- a/test-suite/bugs/closed/4726.v +++ /dev/null @@ -1,19 +0,0 @@ -Set Universe Polymorphism. - -Definition le@{i j} : Type@{j} := - (fun A : Type@{j} => A) - (unit : Type@{i}). -Definition eq@{i j} : Type@{j} := let x := le@{i j} in le@{j i}. - -Record Inj@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} := - { inj : A }. - -Monomorphic Universe u1. -Let ty1 : Type@{u1} := Set. -Check Inj@{Set u1}. -(* Would fail with univ inconsistency if the universe was minimized *) - -Record Inj'@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} := - { inj' : A; foo : Type@{j} := eq@{i j} }. -Fail Check Inj'@{Set u1}. (* Do not drop constraint i = j *) -Check Inj'@{Set Set}. diff --git a/test-suite/bugs/closed/4737.v b/test-suite/bugs/closed/4737.v deleted file mode 100644 index 84ed45e454..0000000000 --- a/test-suite/bugs/closed/4737.v +++ /dev/null @@ -1,9 +0,0 @@ -Goal True. -Proof. -exact I; cycle 1. -Qed. - -Goal True. -Proof. -exact I; swap 1 2. -Qed. diff --git a/test-suite/bugs/closed/4745.v b/test-suite/bugs/closed/4745.v deleted file mode 100644 index c090125e64..0000000000 --- a/test-suite/bugs/closed/4745.v +++ /dev/null @@ -1,35 +0,0 @@ -(*I get an Anomaly in the following code. - -```*) -Require Vector. - -Module M. - Lemma Vector_map_map : - forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n), - Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v. - Proof. - induction v; simpl; auto using f_equal. - Qed. - - Lemma Vector_map_map_transparent : - forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n), - Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v. - Proof. - induction v; simpl; auto using f_equal. - Defined. - (* Anomaly: constant not found in kind_of_head: Coq.Vectors.Vector.t_ind. Please report. *) - - (* strangely, explicitly passing the principle to induction works *) - Lemma Vector_map_map_transparent' : - forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n), - Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v. - Proof. - induction v using Vector.t_ind; simpl; auto using f_equal. - Defined. -End M. -(*``` - -Changing any of the following things eliminates the Anomaly - * moving the lemma out of the module M to the top level - * proving the lemma as a Fixpoint instead of using induction - * proving the analogous lemma on lists instead of vectors*) diff --git a/test-suite/bugs/closed/4746.v b/test-suite/bugs/closed/4746.v deleted file mode 100644 index d64cc6fe68..0000000000 --- a/test-suite/bugs/closed/4746.v +++ /dev/null @@ -1,14 +0,0 @@ -Variables P Q : nat -> Prop. -Variable f : nat -> nat. - -Goal forall (x:nat), (forall y, P y -> forall z, Q z -> y=f z -> False) -> False. -Proof. -intros. -ecase H with (3:=eq_refl). -Abort. - -Goal forall (x:nat), (forall y, y=x -> False) -> False. -Proof. -intros. -unshelve ecase H with (1:=eq_refl). -Qed. diff --git a/test-suite/bugs/closed/4754.v b/test-suite/bugs/closed/4754.v deleted file mode 100644 index 67d645a68f..0000000000 --- a/test-suite/bugs/closed/4754.v +++ /dev/null @@ -1,35 +0,0 @@ - -Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. -Definition f (v : option nat) := match v with - | Some k => Some k - | None => None - end. - -Axioms F G : (option nat -> option nat) -> Prop. -Axiom FG : forall f, f None = None -> F f = G f. - -Axiom admit : forall {T}, T. - -Existing Instance eq_Reflexive. - -Global Instance foo (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. - -Global Instance bar (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> eq ==> Basics.flip Basics.impl) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. - -Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. -Proof. - intro. - pose proof (_ : (Proper (_ ==> eq ==> _) and)). - setoid_rewrite (FG _ _); [ | reflexivity.. ]. - Undo. - setoid_rewrite (FG _ eq_refl). (* Error: Tactic failure: setoid rewrite failed: Nothing to rewrite. in 8.5 *) Admitted. diff --git a/test-suite/bugs/closed/4762.v b/test-suite/bugs/closed/4762.v deleted file mode 100644 index 7a87b07a8e..0000000000 --- a/test-suite/bugs/closed/4762.v +++ /dev/null @@ -1,24 +0,0 @@ -Inductive myand (P Q : Prop) := myconj : P -> Q -> myand P Q. - -Lemma foo P Q R : R = myand P Q -> P -> Q -> R. -Proof. intros ->; constructor; auto. Qed. - -Hint Extern 0 (myand _ _) => eapply foo; [reflexivity| |] : test1. - -Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R). -Proof. - intros. - eauto with test1. -Qed. - -Hint Extern 0 => - match goal with - | |- myand _ _ => eapply foo; [reflexivity| |] - end : test2. - -Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R). -Proof. - intros. - eauto with test2. (* works *) -Qed. - diff --git a/test-suite/bugs/closed/4763.v b/test-suite/bugs/closed/4763.v deleted file mode 100644 index 9613b5c248..0000000000 --- a/test-suite/bugs/closed/4763.v +++ /dev/null @@ -1,13 +0,0 @@ -Require Import Coq.Arith.Arith Coq.Classes.Morphisms Coq.Classes.RelationClasses. -Coercion is_true : bool >-> Sortclass. -Global Instance: Transitive leb. -Admitted. - -Goal forall x y z, leb x y -> leb y z -> True. - intros ??? H H'. - lazymatch goal with - | [ H : is_true (?R ?x ?y), H' : is_true (?R ?y ?z) |- _ ] - => pose proof (transitivity H H' : is_true (R x z)) - end. - exact I. -Qed. diff --git a/test-suite/bugs/closed/4764.v b/test-suite/bugs/closed/4764.v deleted file mode 100644 index e545cc1b71..0000000000 --- a/test-suite/bugs/closed/4764.v +++ /dev/null @@ -1,5 +0,0 @@ -Notation prop_fun x y := (fun (x : Prop) => y). -Definition foo := fun (p : Prop) => p. -Definition bar := fun (_ : Prop) => O. -Print foo. -Print bar. diff --git a/test-suite/bugs/closed/4769.v b/test-suite/bugs/closed/4769.v deleted file mode 100644 index f0c91f7b49..0000000000 --- a/test-suite/bugs/closed/4769.v +++ /dev/null @@ -1,94 +0,0 @@ - -(* -*- mode: coq; coq-prog-args: ("-nois" "-R" "." "Top" "-top" "bug_hom_anom_10") -*- *) -(* File reduced by coq-bug-finder from original input, then from 156 lines to 41 lines, then from 237 lines to 45 lines, then from 163 lines to 66 lines, then from 342 lines to 121 lines, then from 353 lines to 184 lines, then from 343 lines to 255 lines, then from 435 lines to 322 lines, then from 475 lines to 351 lines, then from 442 lines to 377 lines, then from 505 lines to 410 lines, then from 591 lines to 481 lines, then from 596 lines to 535 lines, then from 647 lines to 570 lines, then from 669 lines to 596 lines, then from 687 lines to 620 lines, then from 728 lines to 652 lines, then from 1384 lines to 683 lines, then from 984 lines to 707 lines, then from 1124 lines to 734 lines, then from 775 lines to 738 lines, then from 950 lines to 763 lines, then from 857 lines to 798 lines, then from 983 lines to 752 lines, then from 1598 lines to 859 lines, then from 873 lines to 859 lines, then from 875 lines to 862 lines, then from 901 lines to 863 lines, then from 1047 lines to 865 lines, then from 929 lines to 871 lines, then from 989 lines to 884 lines, then from 900 lines to 884 lines, then from 884 lines to 751 lines, then from 763 lines to 593 lines, then from 482 lines to 232 lines, then from 416 lines to 227 lines, then from 290 lines to 231 lines, then from 348 lines to 235 lines, then from 249 lines to 235 lines, then from 249 lines to 172 lines, then from 186 lines to 172 lines, then from 140 lines to 113 lines, then from 127 lines to 113 lines *) (* coqc version trunk (June 2016) compiled on Jun 2 2016 10:16:20 with OCaml 4.02.3 - coqtop version trunk (June 2016) *) - -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Reserved Notation "x * y" (at level 40, left associativity). -Delimit Scope type_scope with type. -Open Scope type_scope. -Global Set Universe Polymorphism. -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Set Implicit Arguments. -Global Set Nonrecursive Elimination Schemes. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Axiom admit : forall {T}, T. -Delimit Scope function_scope with function. -Notation compose := (fun g f x => g (f x)). -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. -Record PreCategory := - Build_PreCategory { - object :> Type; - morphism : object -> object -> Type; - identity : forall x, morphism x x }. -Bind Scope category_scope with PreCategory. -Record Functor (C D : PreCategory) := { object_of :> C -> D }. -Bind Scope functor_scope with Functor. -Class Isomorphic {C : PreCategory} (s d : C) := {}. -Definition oppositeC (C : PreCategory) : PreCategory - := @Build_PreCategory C (fun s d => morphism C d s) admit. -Notation "C ^op" := (oppositeC C) (at level 3, format "C '^op'") : category_scope. -Definition oppositeF C D (F : Functor C D) : Functor C^op D^op - := Build_Functor (C^op) (D^op) (object_of F). -Definition set_cat : PreCategory := @Build_PreCategory Type (fun x y => x -> y) admit. -Definition prodC (C D : PreCategory) : PreCategory - := @Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) - * morphism D (snd s) (snd d))%type) - admit. -Infix "*" := prodC : category_scope. -Section composition. - Variables B C D E : PreCategory. - Definition composeF (G : Functor D E) (F : Functor C D) : Functor C E := Build_Functor C E (fun c => G (F c)). -End composition. -Infix "o" := composeF : functor_scope. -Definition fstF {C D} : Functor (C * D) C := admit. -Definition sndF {C D} : Functor (C * D) D := admit. -Definition prodF C D D' (F : Functor C D) (F' : Functor C D') : Functor C (D * D') := admit. -Local Infix "*" := prodF : functor_scope. -Definition pairF C D C' D' (F : Functor C D) (F' : Functor C' D') : Functor (C * C') (D * D') - := (F o fstF) * (F' o sndF). -Section hom_functor. - Variable C : PreCategory. - Local Notation obj_of c'c := - ((morphism - C - (fst (c'c : object (C^op * C))) - (snd (c'c : object (C^op * C))))). - Definition hom_functor : Functor (C^op * C) set_cat - := Build_Functor (C^op * C) set_cat (fun c'c => obj_of c'c). -End hom_functor. -Definition identityF C : Functor C C := admit. -Definition functor_category (C D : PreCategory) : PreCategory - := @Build_PreCategory (Functor C D) admit admit. -Local Notation "C -> D" := (functor_category C D) : category_scope. -Definition NaturalIsomorphism (C D : PreCategory) F G := @Isomorphic (C -> D) F G. - -Section Adjunction. - Variables C D : PreCategory. - Variable F : Functor C D. - Variable G : Functor D C. - - Record AdjunctionHom := - { - mate_of : @NaturalIsomorphism - (prodC (oppositeC C) D) - (@set_cat) - (@composeF - (prodC (oppositeC C) D) - (prodC (oppositeC D) D) - (@set_cat) (@hom_functor D) - (@pairF (oppositeC C) - (oppositeC D) D D - (@oppositeF C D F) (identityF D))) - (@composeF - (prodC (oppositeC C) D) - (prodC (oppositeC C) C) - (@set_cat) (@hom_functor C) - (@pairF (oppositeC C) - (oppositeC C) D C - (identityF (oppositeC C)) G)) - }. -End Adjunction. diff --git a/test-suite/bugs/closed/4772.v b/test-suite/bugs/closed/4772.v deleted file mode 100644 index c3109fa31c..0000000000 --- a/test-suite/bugs/closed/4772.v +++ /dev/null @@ -1,6 +0,0 @@ - -Record TruncType := BuildTruncType { - trunctype_type : Type -}. - -Fail Arguments BuildTruncType _ _ {_}. (* This should fail *) diff --git a/test-suite/bugs/closed/4780.v b/test-suite/bugs/closed/4780.v deleted file mode 100644 index 71a51c6312..0000000000 --- a/test-suite/bugs/closed/4780.v +++ /dev/null @@ -1,106 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-R" "." "Top" "-top" "bug_bad_induction_01") -*- *) -(* File reduced by coq-bug-finder from original input, then from 1889 lines to 144 lines, then from 158 lines to 144 lines *) -(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3 - coqtop version 8.5pl1 (April 2016) *) -Axiom proof_admitted : False. -Tactic Notation "admit" := abstract case proof_admitted. -Global Set Universe Polymorphism. -Global Set Asymmetric Patterns. -Notation "'exists' x .. y , p" := (sigT (fun x => .. (sigT (fun y => p)) ..)) - (at level 200, x binder, right associativity, - format "'[' 'exists' '/ ' x .. y , '/ ' p ']'") - : type_scope. -Definition relation (A : Type) := A -> A -> Type. -Class Transitive {A} (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z. -Tactic Notation "etransitivity" open_constr(y) := - let R := match goal with |- ?R ?x ?z => constr:(R) end in - let x := match goal with |- ?R ?x ?z => constr:(x) end in - let z := match goal with |- ?R ?x ?z => constr:(z) end in - refine (@transitivity _ R _ x y z _ _). -Tactic Notation "etransitivity" := etransitivity _. -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation pr1 := projT1. -Notation pr2 := projT2. -Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. -Notation "x .2" := (projT2 x) (at level 3) : fibration_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Arguments idpath {A a} , [A] a. -Arguments paths_rect [A] a P f y p. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Delimit Scope path_scope with path. -Local Open Scope path_scope. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. -Instance transitive_paths {A} : Transitive (@paths A) | 0 := @concat A. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. -Notation "1" := idpath : path_scope. -Notation "p @ q" := (concat p q) (at level 20) : path_scope. -Notation "p ^" := (inverse p) (at level 3) : path_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. -Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): - p # (f x) = f y - := match p with idpath => idpath end. -Lemma transport_compose {A B} {x y : A} (P : B -> Type) (f : A -> B) - (p : x = y) (z : P (f x)) - : transport (fun x => P (f x)) p z = transport P (ap f p) z. -admit. -Defined. -Local Open Scope path_scope. -Generalizable Variables X A B C f g n. -Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (pq : {p : u.1 = v.1 & p # u.2 = v.2}) - : u = v - := match pq with - | existT p q => - match u, v return (forall p0 : (u.1 = v.1), (p0 # u.2 = v.2) -> (u=v)) with - | (x;y), (x';y') => fun p1 q1 => - match p1 in (_ = x'') return (forall y'', (p1 # y = y'') -> (x;y)=(x'';y'')) with - | idpath => fun y' q2 => - match q2 in (_ = y'') return (x;y) = (x;y'') with - | idpath => 1 - end - end y' q1 - end p q - end. -Definition path_sigma {A : Type} (P : A -> Type) (u v : sigT P) - (p : u.1 = v.1) (q : p # u.2 = v.2) - : u = v - := path_sigma_uncurried P u v (p;q). -Definition projT1_path `{P : A -> Type} {u v : sigT P} (p : u = v) - : u.1 = v.1 - := - ap (@projT1 _ _) p. -Notation "p ..1" := (projT1_path p) (at level 3) : fibration_scope. -Definition projT2_path `{P : A -> Type} {u v : sigT P} (p : u = v) - : p..1 # u.2 = v.2 - := (transport_compose P (@projT1 _ _) p u.2)^ - @ (@apD {x:A & P x} _ (@projT2 _ _) _ _ p). -Notation "p ..2" := (projT2_path p) (at level 3) : fibration_scope. -Definition eta_path_sigma_uncurried `{P : A -> Type} {u v : sigT P} - (p : u = v) - : path_sigma_uncurried _ _ _ (p..1; p..2) = p. -admit. -Defined. -Definition eta_path_sigma `{P : A -> Type} {u v : sigT P} (p : u = v) - : path_sigma _ _ _ (p..1) (p..2) = p - := eta_path_sigma_uncurried p. - -Definition path_path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (p q : u = v) - (rs : {r : p..1 = q..1 & transport (fun x => transport P x u.2 = v.2) r p..2 = q..2}) - : p = q. -Proof. - destruct rs, p, u. - etransitivity; [ | apply eta_path_sigma ]. - simpl in *. - induction p0. - admit. -Defined. - diff --git a/test-suite/bugs/closed/4782.v b/test-suite/bugs/closed/4782.v deleted file mode 100644 index 1e1a4cb9c2..0000000000 --- a/test-suite/bugs/closed/4782.v +++ /dev/null @@ -1,26 +0,0 @@ -(* About typing of with bindings *) - -Record r : Type := mk_r { type : Type; cond : type -> Prop }. - -Inductive p : Prop := consp : forall (e : r) (x : type e), cond e x -> p. - -Goal p. -Fail apply consp with (fun _ : bool => mk_r unit (fun x => True)) nil. -Abort. - -(* A simplification of an example from coquelicot, which was failing - at some time after a fix #4782 was committed. *) - -Record T := { dom : Type }. -Definition pairT A B := {| dom := (dom A * dom B)%type |}. -Class C (A:Type). -Parameter B:T. -Instance c (A:T) : C (dom A). -Instance cn : C (dom B). -Parameter F : forall A:T, C (dom A) -> forall x:dom A, x=x -> A = A. -Set Typeclasses Debug. -Goal forall (A:T) (x:dom A), pairT A A = pairT A A. -intros. -apply (F _ _) with (x,x). -Abort. - diff --git a/test-suite/bugs/closed/4785.v b/test-suite/bugs/closed/4785.v deleted file mode 100644 index 0d347b262d..0000000000 --- a/test-suite/bugs/closed/4785.v +++ /dev/null @@ -1,34 +0,0 @@ -Require Coq.Lists.List Coq.Vectors.Vector. - -Module A. -Import Coq.Lists.List Coq.Vectors.Vector. -Import ListNotations. -Check [ ]%list : list _. -Import VectorNotations ListNotations. -Delimit Scope vector_scope with vector. -Check [ ]%vector : Vector.t _ _. -Check []%vector : Vector.t _ _. -Check [ ]%list : list _. -Check []%list : list _. - -Goal True. - idtac; []. (* Check that vector notations don't break the [ | .. | ] syntax of Ltac *) -Abort. - -Inductive mylist A := mynil | mycons (x : A) (xs : mylist A). -Delimit Scope mylist_scope with mylist. -Bind Scope mylist_scope with mylist. -Arguments mynil {_}, _. -Arguments mycons {_} _ _. -Notation " [ ] " := mynil (format "[ ]") : mylist_scope. -Notation " [ x ] " := (mycons x nil) : mylist_scope. -Notation " [ x ; y ; .. ; z ] " := (mycons x (mycons y .. (mycons z nil) ..)) : mylist_scope. - -Locate Module VectorNotations. -Import VectorDef.VectorNotations. - -Check []%vector : Vector.t _ _. -Check []%mylist : mylist _. -Check [ ]%mylist : mylist _. -Check [ ]%list : list _. -End A. diff --git a/test-suite/bugs/closed/4787.v b/test-suite/bugs/closed/4787.v deleted file mode 100644 index b586cba50f..0000000000 --- a/test-suite/bugs/closed/4787.v +++ /dev/null @@ -1,9 +0,0 @@ -(* [Unset Bracketing Last Introduction Pattern] was not working *) - -Unset Bracketing Last Introduction Pattern. - -Goal forall T (x y : T * T), fst x = fst y /\ snd x = snd y -> x = y. -do 10 ((intros [] || intro); simpl); reflexivity. -Qed. - - diff --git a/test-suite/bugs/closed/4798.v b/test-suite/bugs/closed/4798.v deleted file mode 100644 index 41a1251ca5..0000000000 --- a/test-suite/bugs/closed/4798.v +++ /dev/null @@ -1,3 +0,0 @@ -Check match 2 with 0 => 0 | S n => n end. -Notation "|" := 1 (compat "8.7"). -Check match 2 with 0 => 0 | S n => n end. (* fails *) diff --git a/test-suite/bugs/closed/4811.v b/test-suite/bugs/closed/4811.v deleted file mode 100644 index fe6e65a0f0..0000000000 --- a/test-suite/bugs/closed/4811.v +++ /dev/null @@ -1,1685 +0,0 @@ -(* Test about a slowness of f_equal in 8.5pl1 *) - -(* Submitted by Jason Gross *) - -(* -*- mode: coq; coq-prog-args: ("-R" "src" "Crypto" "-R" "Bedrock" "Bedrock" "-R" "coqprime-8.5/Coqprime" "Coqprime" "-top" "GF255192") -*- *) -(* File reduced by coq-bug-finder from original input, then from 162 lines to 23 lines, then from 245 lines to 95 lines, then from 198 lines to 101 lines, then from 654 lines to 452 lines, then from 591 lines to 505 lines, then from 1770 lines to 580 lines, then from 2238 lines to 1715 lines, then from 1776 lines to 1738 lines, then from 1750 lines to 1679 lines, then from 1693 lines to 1679 lines *) -(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3 - coqtop version 8.5pl1 (April 2016) *) -Require Coq.ZArith.ZArith. - -Import Coq.ZArith.ZArith. - -Axiom F : Z -> Set. -Definition Let_In {A P} (x : A) (f : forall y : A, P y) - := let y := x in f y. -Local Open Scope Z_scope. -Definition modulus : Z := 2^255 - 19. -Axiom decode : list Z -> F modulus. -Goal forall x9 x8 x7 x6 x5 x4 x3 x2 x1 x0 y9 y8 y7 y6 y5 y4 y3 y2 y1 y0 : Z, - let Zmul := Z.mul in - let Zadd := Z.add in - let Zsub := Z.sub in - let Zpow_pos := Z.pow_pos in - @eq (F (Zsub (Zpow_pos (Zpos (xO xH)) (xI (xI (xI (xI (xI (xI (xI xH)))))))) (Zpos (xI (xI (xO (xO xH))))))) - (@decode - (@Let_In Z (fun _ : Z => list Z) - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (fun z : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (fun z0 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z0 (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (fun z1 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z1 (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8)) - (Zmul x4 y9))))) - (fun z2 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z2 (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (fun z3 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z3 (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4)) - (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (fun z4 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z4 (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) - (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) - (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) - (fun z5 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z5 (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) - (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (fun z6 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z6 (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) - (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) - (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) - (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) - (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (fun z7 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z7 (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) - (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) - (Zmul x1 y8)) (Zmul x0 y9))) - (fun z8 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Zmul (Zpos (xI (xI (xO (xO xH))))) (Z.shiftr z8 (Zpos (xI (xO (xO (xI xH))))))) - (Z.land z - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) - (fun z9 : Z => - @cons Z - (Z.land z9 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Zadd (Z.shiftr z9 (Zpos (xO (xI (xO (xI xH)))))) - (Z.land z0 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z1 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z2 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land z3 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z4 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land z5 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z6 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land z7 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z8 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@nil Z))))))))))))))))))))))) - (@decode - (@cons Z - (Z.land - (Zadd - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x9 y2) (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) - (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) - (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) - (Zmul x6 y7)) (Zmul x5 y8)) - (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) - (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) - (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) - (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) - (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) - (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) - (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) - (Zmul x0 y8)) (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) (Zmul x5 y4)) - (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9))) - (Zpos (xI (xO (xO (xI xH))))))) - (Z.land - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Zadd - (Z.shiftr - (Zadd - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul - (Zmul x5 y5) - (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul x9 y2) - (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) - (Zmul x3 y8)) - (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zmul x2 y0) - (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul (Zmul x9 y3) (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) - (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) - (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) - (Zmul x7 y6)) (Zmul x6 y7)) - (Zmul x5 y8)) (Zmul x4 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) - (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) - (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) - (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) - (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) - (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) - (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) - (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) - (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) - (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) - (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) - (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) - (Zmul x1 y8)) (Zmul x0 y9))) (Zpos (xI (xO (xO (xI xH))))))) - (Z.land - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Z.land - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) - (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) - (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8)) - (Zmul x4 y9))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) - (Zmul x6 y5)) (Zmul x5 y6)) (Zmul x4 y7)) - (Zmul x3 y8)) (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8)) - (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) - (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) - (Zmul x6 y5)) (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) - (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) - (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4)) - (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul (Zmul x9 y1) (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) - (Zmul x7 y4)) (Zmul x6 y5)) - (Zmul x5 y6)) (Zmul x4 y7)) - (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) - (Zmul x8 y4)) (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) - (Zmul x6 y7)) (Zmul x5 y8)) (Zmul x4 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) - (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) - (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) - (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) - (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x9 y2) (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) - (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) - (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) - (Zmul x6 y7)) (Zmul x5 y8)) - (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) - (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) - (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) - (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) - (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul - (Zmul x5 y5) - (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul - (Zmul x3 y7) - (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul x9 y2) - (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) - (Zmul x3 y8)) - (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zmul x2 y0) - (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y3) - (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) - (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) - (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) - (Zmul x7 y6)) (Zmul x6 y7)) - (Zmul x5 y8)) (Zmul x4 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) - (Zmul x8 y6)) (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) - (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) - (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) - (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) - (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) - (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) - (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5)) - (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) - (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH)))) - (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH)))) - (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) - (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul - (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul - (Zmul x5 y5) - (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul - (Zmul x3 y7) - (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul - (Zmul x1 y9) - (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul x9 y2) - (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) - (Zmul x3 y8)) - (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zmul x2 y0) - (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y3) - (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul - (Zmul x7 y5) - (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul - (Zmul x5 y7) - (Zpos (xO xH)))) - (Zmul x4 y8)) - (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) - (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x9 y4) (Zmul x8 y5)) - (Zmul x7 y6)) - (Zmul x6 y7)) - (Zmul x5 y8)) - (Zmul x4 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x4 y0) - (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) - (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) - (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) - (Zmul x2 y3)) (Zmul x1 y4)) - (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) - (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x6 y0) - (Zmul (Zmul x5 y1) (Zpos (xO xH)))) - (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) - (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) - (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) - (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5)) - (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) - (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH)))) - (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH)))) - (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) - (Zmul x0 y8)) - (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) - (Zmul x6 y3)) (Zmul x5 y4)) (Zmul x4 y5)) - (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@nil Z)))))))))))). - cbv beta zeta. - intros. - (timeout 1 (apply f_equal; reflexivity)) || fail 0 "too early". - Undo. - Time Timeout 1 f_equal. (* Finished transaction in 0. secs (0.3u,0.s) in 8.4 *) diff --git a/test-suite/bugs/closed/4813.v b/test-suite/bugs/closed/4813.v deleted file mode 100644 index 5f8ea74c1a..0000000000 --- a/test-suite/bugs/closed/4813.v +++ /dev/null @@ -1,9 +0,0 @@ -(* On the strength of "apply with" (see also #4782) *) - -Record ProverT := { Facts : Type }. -Record ProverT_correct (P : ProverT) := { Valid : Facts P -> Prop ; - Valid_weaken : Valid = Valid }. -Definition reflexivityValid (_ : unit) := True. -Definition reflexivityProver_correct : ProverT_correct {| Facts := unit |}. -Proof. - eapply Build_ProverT_correct with (Valid := reflexivityValid). diff --git a/test-suite/bugs/closed/4816.v b/test-suite/bugs/closed/4816.v deleted file mode 100644 index 00a523842e..0000000000 --- a/test-suite/bugs/closed/4816.v +++ /dev/null @@ -1,29 +0,0 @@ -Section foo. -Polymorphic Universes A B. -Fail Constraint A <= B. -End foo. -(* gives an anomaly Universe undefined *) - -Universes X Y. -Section Foo. - Polymorphic Universes Z W. - Polymorphic Constraint W < Z. - - Fail Definition bla := Type@{W}. - Polymorphic Definition bla := Type@{W}. - Section Bar. - Fail Constraint X <= Z. - End Bar. -End Foo. - -Require Coq.Classes.RelationClasses. - -Class PreOrder (A : Type) (r : A -> A -> Type) : Type := -{ refl : forall x, r x x }. - -Section qux. - Polymorphic Universes A. - Section bar. - Fail Context {A : Type@{A}} {rA : A -> A -> Prop} {PO : PreOrder A rA}. - End bar. -End qux. diff --git a/test-suite/bugs/closed/4818.v b/test-suite/bugs/closed/4818.v deleted file mode 100644 index e411ce62f0..0000000000 --- a/test-suite/bugs/closed/4818.v +++ /dev/null @@ -1,24 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-R" "." "Prob" "-top" "Product") -*- *) -(* File reduced by coq-bug-finder from original input, then from 391 lines to 77 lines, then from 857 lines to 119 lines, then from 1584 lines to 126 lines, then from 362 lines to 135 lines, then from 149 lines to 135 lines *) -(* coqc version 8.5pl1 (June 2016) compiled on Jun 9 2016 17:27:17 with OCaml 4.02.3 - coqtop version 8.5pl1 (June 2016) *) -Set Universe Polymorphism. - -Inductive GCov (I : Type) : Type := | Foo : I -> GCov I. - -Section Product. - -Variables S IS : Type. -Variable locS : IS -> True. - -Goal GCov (IS * S) -> GCov IS. -intros X0. induction X0; intros. -destruct i. -specialize (locS i). -clear -locS. -destruct locS. Show Universes. -Admitted. - -(* -Anomaly: Universe Product.5189 undefined. Please report. -*) diff --git a/test-suite/bugs/closed/4844.v b/test-suite/bugs/closed/4844.v deleted file mode 100644 index f140939ccd..0000000000 --- a/test-suite/bugs/closed/4844.v +++ /dev/null @@ -1,47 +0,0 @@ - -(* Bug report 4844 (and 4824): - The Haskell extraction was erroneously considering [Any] and - [()] as convertible ([Tunknown] an [Tdummy] internally). *) - -(* A value with inner logical parts. - Its extracted type will be [Sum () ()]. *) - -Definition semilogic : True + True := inl I. - -(* Higher-order record, whose projection [ST] isn't expressible - as an Haskell (or OCaml) type. Hence [ST] is extracted as the - unknown type [Any] in Haskell. *) - -Record SomeType := { ST : Type }. - -Definition SomeTrue := {| ST := True |}. - -(* A first version of the issue: - [abstrSum] is extracted as [Sum Any Any], so an unsafeCoerce - is required to cast [semilogic] into [abstrSum SomeTrue]. *) - -Definition abstrSum (t : SomeType) := ((ST t) + (ST t))%type. - -Definition semilogic' : abstrSum SomeTrue := semilogic. - -(* A deeper version of the issue. - In the previous example, the extraction could have reduced - [abstrSum SomeTrue] into [True+True], solving the issue. - It might do so in future versions. But if we put an inductive - in the way, a reduction isn't helpful. *) - -Inductive box (t : SomeType) := Box : ST t + ST t -> box t. - -Definition boxed_semilogic : box SomeTrue := - Box SomeTrue semilogic. - -Require Extraction. -Extraction Language Haskell. -Recursive Extraction semilogic' boxed_semilogic. -(* Warning! To fully check that this bug is still closed, - you should run ghc on the extracted code: - -Extraction "bug4844.hs" semilogic' boxed_semilogic. -ghc bug4844.hs - -*) diff --git a/test-suite/bugs/closed/4852.v b/test-suite/bugs/closed/4852.v deleted file mode 100644 index 5068ed9b95..0000000000 --- a/test-suite/bugs/closed/4852.v +++ /dev/null @@ -1,54 +0,0 @@ -(** BZ 4852 : unsatisfactory Extraction Implicit for a fixpoint defined via wf *) - -Require Import Coq.Lists.List. -Import ListNotations. -Require Import Omega. - -Definition wfi_lt := well_founded_induction_type Wf_nat.lt_wf. - -Tactic Notation "wfinduction" constr(term) "on" ne_hyp_list(Hs) "as" ident(H) := - let R := fresh in - let E := fresh in - remember term as R eqn:E; - revert E; revert Hs; - induction R as [R H] using wfi_lt; - intros; subst R. - -Hint Rewrite @app_comm_cons @app_assoc @app_length : app_rws. - -Ltac solve_nat := autorewrite with app_rws in *; cbn in *; omega. - -Notation "| x |" := (length x) (at level 11, no associativity, format "'|' x '|'"). - -Definition split_acc (ls : list nat) : forall acc1 acc2, - (|acc1| = |acc2| \/ |acc1| = S (|acc2|)) -> - { lss : list nat * list nat | - let '(ls1, ls2) := lss in |ls1++ls2| = |ls++acc1++acc2| /\ (|ls1| = |ls2| \/ |ls1| = S (|ls2|))}. -Proof. - induction ls as [|a ls IHls]. all:intros acc1 acc2 H. - { exists (acc1, acc2). cbn. intuition reflexivity. } - destruct (IHls (a::acc2) acc1) as [[ls1 ls2] (H1 & H2)]. 1:solve_nat. - exists (ls1, ls2). cbn. intuition solve_nat. -Defined. - -Definition join(ls : list nat) : { rls : list nat | |rls| = |ls| }. -Proof. - wfinduction (|ls|) on ls as IH. - case (split_acc ls [] []). 1:solve_nat. - intros (ls1 & ls2) (H1 & H2). - destruct ls2 as [|a ls2]. - - exists ls1. solve_nat. - - unshelve eelim (IH _ _ ls1 eq_refl). 1:solve_nat. intros rls1 H3. - unshelve eelim (IH _ _ ls2 eq_refl). 1:solve_nat. intros rls2 H4. - exists (a :: rls1 ++ rls2). solve_nat. -Defined. - -Require Import ExtrOcamlNatInt. -Extract Inlined Constant length => "List.length". -Extract Inlined Constant app => "List.append". - -Extraction Inline wfi_lt. -Extraction Implicit wfi_lt [1 3]. -Recursive Extraction join. (* was: Error: An implicit occurs after extraction *) -Extraction TestCompile join. - diff --git a/test-suite/bugs/closed/4858.v b/test-suite/bugs/closed/4858.v deleted file mode 100644 index a2fa93832a..0000000000 --- a/test-suite/bugs/closed/4858.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Nsatz. -Goal True. -try nsatz_compute - (PEc 0%Z :: PEc (-1)%Z - :: PEpow (PEsub (PEX Z 2) (PEX Z 3)) 1 - :: PEsub (PEX Z 1) (PEX Z 1) :: nil). -Abort. diff --git a/test-suite/bugs/closed/4859.v b/test-suite/bugs/closed/4859.v deleted file mode 100644 index 7be0bedcfc..0000000000 --- a/test-suite/bugs/closed/4859.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Not supported but check at least that it does not raise an anomaly *) - -Inductive Fin{n : nat} : Set := -| F1{i : nat}{e : n = S i} -| FS{i : nat}(f : @ Fin i){e : n = S i}. - -Fail Scheme Equality for Fin. diff --git a/test-suite/bugs/closed/4863.v b/test-suite/bugs/closed/4863.v deleted file mode 100644 index 1e47f2957b..0000000000 --- a/test-suite/bugs/closed/4863.v +++ /dev/null @@ -1,33 +0,0 @@ -Require Import Classes.DecidableClass. - -Inductive Foo : Set := -| foo1 | foo2. - -Lemma Decidable_sumbool : forall P, {P}+{~P} -> Decidable P. -Proof. - intros P H. - refine (Build_Decidable _ (if H then true else false) _). - intuition congruence. -Qed. - -Hint Extern 100 (Decidable (?A = ?B)) => abstract (abstract (abstract (apply Decidable_sumbool; decide equality))) : typeclass_instances. - -Goal forall (a b : Foo), {a=b}+{a<>b}. -intros. -abstract (abstract (decide equality)). (*abstract works here*) -Qed. - -Check ltac:(abstract (exact I)) : True. - -Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). -intros. -split. typeclasses eauto. -typeclasses eauto. Qed. - -Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). -intros. -split. -refine _. -refine _. -Defined. -(*fails*) diff --git a/test-suite/bugs/closed/4865.v b/test-suite/bugs/closed/4865.v deleted file mode 100644 index da4e53aab0..0000000000 --- a/test-suite/bugs/closed/4865.v +++ /dev/null @@ -1,52 +0,0 @@ -(* Check discharge of arguments scopes + other checks *) - -(* This is bug #4865 *) - -Notation "" := true : bool_scope. -Section A. - Check negb . - Global Arguments negb : clear scopes. - Fail Check negb . -End A. - -(* Check that no scope is re-computed *) -Fail Check negb . - -(* Another test about arguments scopes in sections *) - -Notation "0" := true. -Section B. - Variable x : nat. - Let T := nat -> nat. - Definition f y : T := fun z => x + y + z. - Fail Check f 1 0. (* 0 in nat, 0 in bool *) - Fail Check f 0 0. (* 0 in nat, 0 in bool *) - Check f 0 1. (* 0 and 1 in nat *) - Global Arguments f _%nat_scope _%nat_scope. - Check f 0 0. (* both 0 in nat *) -End B. - -(* Check that only the scope for the extra product on x is re-computed *) -Check f 0 0 0. (* All 0 in nat *) - -Section C. - Variable x : nat. - Let T := nat -> nat. - Definition g y : T := fun z => x + y + z. - Global Arguments g : clear scopes. - Check g 1. (* 1 in nat *) -End C. - -(* Check that only the scope for the extra product on x is re-computed *) -Check g 0. (* 0 in nat *) -Fail Check g 0 1 0. (* 2nd 0 in bool *) -Fail Check g 0 0 1. (* 2nd 0 in bool *) - -(* Another test on arguments scopes: checking scope for expanding arities *) -(* Not sure this is very useful, but why not *) - -Fixpoint arr n := match n with 0%nat => nat | S n => nat -> arr n end. -Fixpoint lam n : arr n := match n with 0%nat => 0%nat | S n => fun x => lam n end. -Notation "0" := true. -Arguments lam _%nat_scope _%nat_scope : extra scopes. -Check (lam 1 0). diff --git a/test-suite/bugs/closed/4869.v b/test-suite/bugs/closed/4869.v deleted file mode 100644 index ac5d7ea287..0000000000 --- a/test-suite/bugs/closed/4869.v +++ /dev/null @@ -1,18 +0,0 @@ -Universes i. - -Fail Constraint i < Set. -Fail Constraint i <= Set. -Fail Constraint i = Set. -Constraint Set <= i. -Constraint Set < i. -Fail Constraint i < j. (* undeclared j *) -Fail Constraint i < Type. (* anonymous *) - -Set Universe Polymorphism. - -Section Foo. - Universe j. - Constraint Set < j. - - Definition foo := Type@{j}. -End Foo. diff --git a/test-suite/bugs/closed/4873.v b/test-suite/bugs/closed/4873.v deleted file mode 100644 index 39299883ad..0000000000 --- a/test-suite/bugs/closed/4873.v +++ /dev/null @@ -1,71 +0,0 @@ -Require Import Coq.Classes.Morphisms. -Require Import Relation_Definitions. - -Fixpoint tuple' T n : Type := - match n with - | O => T - | S n' => (tuple' T n' * T)%type - end. - -Definition tuple T n : Type := - match n with - | O => unit - | S n' => tuple' T n' - end. - -Fixpoint to_list' {T} (n:nat) {struct n} : tuple' T n -> list T := - match n with - | 0 => fun x => (x::nil)%list - | S n' => fun xs : tuple' T (S n') => let (xs', x) := xs in (x :: to_list' n' xs')%list - end. - -Definition to_list {T} (n:nat) : tuple T n -> list T := - match n with - | 0 => fun _ => nil - | S n' => fun xs : tuple T (S n') => to_list' n' xs - end. - -Program Fixpoint from_list' {T} (y:T) (n:nat) (xs:list T) : length xs = n -> tuple' T n := - match n return _ with - | 0 => - match xs return (length xs = 0 -> tuple' T 0) with - | nil => fun _ => y - | _ => _ (* impossible *) - end - | S n' => - match xs return (length xs = S n' -> tuple' T (S n')) with - | cons x xs' => fun _ => (from_list' x n' xs' _, y) - | _ => _ (* impossible *) - end - end. -Goal True. - pose from_list'_obligation_3 as e. - repeat (let e' := fresh in - rename e into e'; - (pose (e' nat) as e || pose (e' 0) as e || pose (e' nil) as e || pose (e' eq_refl) as e); - subst e'). - progress hnf in e. - pose (eq_refl : e = eq_refl). - exact I. -Qed. - -Program Definition from_list {T} (n:nat) (xs:list T) : length xs = n -> tuple T n := -match n return _ with -| 0 => - match xs return (length xs = 0 -> tuple T 0) with - | nil => fun _ : 0 = 0 => tt - | _ => _ (* impossible *) - end -| S n' => - match xs return (length xs = S n' -> tuple T (S n')) with - | cons x xs' => fun _ => from_list' x n' xs' _ - | _ => _ (* impossible *) - end -end. - -Lemma to_list_from_list : forall {T} (n:nat) (xs:list T) pf, to_list n (from_list n xs pf) = xs. -Proof. - destruct xs; simpl; intros; subst; auto. - generalize dependent t. simpl in *. - induction xs; simpl in *; intros; congruence. -Qed. diff --git a/test-suite/bugs/closed/4877.v b/test-suite/bugs/closed/4877.v deleted file mode 100644 index 7d153d9828..0000000000 --- a/test-suite/bugs/closed/4877.v +++ /dev/null @@ -1,12 +0,0 @@ -Ltac induction_last := - let v := match goal with - | |- forall x y, _ = _ -> _ => 1 - | |- forall x y, _ -> _ = _ -> _ => 2 - | |- forall x y, _ -> _ -> _ = _ -> _ => 3 - end in - induction v. - -Goal forall n m : nat, True -> n = m -> m = n. - induction_last. - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/4880.v b/test-suite/bugs/closed/4880.v deleted file mode 100644 index 5569798d54..0000000000 --- a/test-suite/bugs/closed/4880.v +++ /dev/null @@ -1,11 +0,0 @@ -Require Import Coq.Reals.Reals Coq.nsatz.Nsatz. -Local Open Scope R. - -Goal forall x y : R, - x*x = y * y -> - x*x = -y * -y -> - x*(x*x) = 0 -> (* The associativity does not actually matter, *) - (x*x)*x = 0. (* just otherwise [assumption] would solve the goal. *) -Proof. - nsatz. -Qed. diff --git a/test-suite/bugs/closed/4893.v b/test-suite/bugs/closed/4893.v deleted file mode 100644 index 9a35bcf954..0000000000 --- a/test-suite/bugs/closed/4893.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal True. -evar (P: Prop). -assert (H : P); [|subst P]; [exact I|]. -let T := type of H in not_evar T. diff --git a/test-suite/bugs/closed/4904.v b/test-suite/bugs/closed/4904.v deleted file mode 100644 index a47c3b07a9..0000000000 --- a/test-suite/bugs/closed/4904.v +++ /dev/null @@ -1,11 +0,0 @@ -Module A. -Module B. -Notation mynat := nat. -Notation nat := nat. -End B. -End A. - -Print A.B.nat. (* Notation A.B.nat := nat *) -Import A. -Print B.mynat. -Print B.nat. diff --git a/test-suite/bugs/closed/4932.v b/test-suite/bugs/closed/4932.v deleted file mode 100644 index 219d532ac6..0000000000 --- a/test-suite/bugs/closed/4932.v +++ /dev/null @@ -1,44 +0,0 @@ -(* Testing recursive notations with binders seen as terms *) - -Inductive ftele : Type := -| fb {T:Type} : T -> ftele -| fr {T} : (T -> ftele) -> ftele. - -Fixpoint args ftele : Type := - match ftele with - | fb _ => unit - | fr f => sigT (fun t => args (f t)) - end. - -Definition fpack := sigT args. -Definition pack fp fa : fpack := existT _ fp fa. - -Notation "'tele' x .. z := b" := - ( - (fun x => .. - (fun z => - pack - (fr (fun x => .. ( fr (fun z => fb b) ) .. ) ) - (existT _ x .. (existT _ z tt) .. ) - ) .. - ) - ) (at level 85, x binder, z binder). - -Check fun '((y,z):nat*nat) => pack (fr (fun '((y,z):nat*nat) => fb tt)) - (existT _ (y,z) tt). - -Example test := tele (t : Type) := tt. -Example test' := test nat. -Print test. - -Example test2 := tele (t : Type) (x:t) := tt. -Example test2' := test2 nat 0. -Print test2. - -Example test3 := tele (t : Type) (y:=0) (x:t) := tt. -Example test3' := test3 nat 0. -Print test3. - -Example test4 := tele (t : Type) '((y,z):nat*nat) (x:t) := tt. -Example test4' := test4 nat (1,2) 3. -Print test4. diff --git a/test-suite/bugs/closed/4955.v b/test-suite/bugs/closed/4955.v deleted file mode 100644 index dce1f764c3..0000000000 --- a/test-suite/bugs/closed/4955.v +++ /dev/null @@ -1,98 +0,0 @@ -(* An example involving a first-order unification triggering a cyclic constraint *) - -Module A. -Notation "{ x : A | P }" := (sigT (fun x:A => P)). -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation "p @ q" := (eq_trans p q) (at level 20). -Notation "p ^" := (eq_sym p) (at level 3). -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) -: P y := - match p with eq_refl => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only -parsing). -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with eq_refl => eq_refl end. -Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): p # (f -x) = f y - := match p with eq_refl => eq_refl end. -Axiom transport_compose - : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f -x)), - transport (fun x => P (f x)) p z = transport P (ap f p) z. -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Delimit Scope functor_scope with functor. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) -(object_of d) }. -Arguments object_of {C%category D%category} f%functor c%object : rename, simpl -nomatch. -Arguments morphism_of [C%category] [D%category] f%functor [s%object d%object] -m%morphism : rename, simpl nomatch. -Section path_functor. - Variable C : PreCategory. - Variable D : PreCategory. - - Local Notation path_functor'_T F G - := { HO : object_of F = object_of G - | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) -(GO d)) - HO - (morphism_of F) - = morphism_of G } - (only parsing). - Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> -path_functor'_T F G - := fun H' - => (ap object_of H'; - (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H'). - -End path_functor. -End A. - -(* A variant of it with more axioms *) - -Module B. -Notation "{ x : A | P }" := (sigT (fun x:A => P)). -Notation "( x ; y )" := (existT _ x y). -Notation "p @ q" := (eq_trans p q) (at level 20). -Notation "p ^" := (eq_sym p) (at level 3). -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only -parsing). -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with eq_refl => eq_refl end. -Axiom apD : forall {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y), p # (f -x) = f y. -Axiom transport_compose - : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f -x)), - transport (fun x => P (f x)) p z = transport P (ap f p) z. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) -(object_of d) }. -Arguments object_of {C D} f c : rename, simpl nomatch. -Arguments morphism_of [C] [D] f [s d] m : rename, simpl nomatch. -Section path_functor. - Variable C D : PreCategory. - Local Notation path_functor'_T F G - := { HO : object_of F = object_of G - | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) -(GO d)) - HO - (morphism_of F) - = morphism_of G }. - Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> -path_functor'_T F G - := fun H' - => (ap object_of H'; - (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H'). - -End path_functor. -End B. diff --git a/test-suite/bugs/closed/4957.v b/test-suite/bugs/closed/4957.v deleted file mode 100644 index 0efd87ac0d..0000000000 --- a/test-suite/bugs/closed/4957.v +++ /dev/null @@ -1,6 +0,0 @@ -Ltac get_value H := eval cbv delta [H] in H. - -Goal True. -refine (let X := _ in _). -let e := get_value X in unify e Prop. -Abort. diff --git a/test-suite/bugs/closed/4966.v b/test-suite/bugs/closed/4966.v deleted file mode 100644 index bd93cdc858..0000000000 --- a/test-suite/bugs/closed/4966.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Interpretation of auto as an argument of an ltac function (i.e. as an ident) was wrongly "auto with *" *) - -Axiom proof_admitted : False. -Hint Extern 0 => case proof_admitted : unused. -Ltac do_tac tac := tac. - -Goal False. - Set Ltac Profiling. - Fail solve [ do_tac auto ]. -Abort. diff --git a/test-suite/bugs/closed/4969.v b/test-suite/bugs/closed/4969.v deleted file mode 100644 index 4dee41e221..0000000000 --- a/test-suite/bugs/closed/4969.v +++ /dev/null @@ -1,11 +0,0 @@ -Require Import Classes.Init. - -Class C A := c : A. -Instance nat_C : C nat := 0. -Instance bool_C : C bool := true. -Lemma silly {A} `{C A} : 0 = 0 -> c = c -> True. -Proof. auto. Qed. - -Goal True. - class_apply @silly; [reflexivity|]. - reflexivity. Fail Qed. diff --git a/test-suite/bugs/closed/4970.v b/test-suite/bugs/closed/4970.v deleted file mode 100644 index 7a896582f5..0000000000 --- a/test-suite/bugs/closed/4970.v +++ /dev/null @@ -1,3 +0,0 @@ -(* Check "{{" is not confused with "{" in notations *) -Reserved Notation "x {{ y }}" (at level 40). -Notation "x {{ y }}" := (x y) (only parsing). diff --git a/test-suite/bugs/closed/5011.v b/test-suite/bugs/closed/5011.v deleted file mode 100644 index c3043ca5d1..0000000000 --- a/test-suite/bugs/closed/5011.v +++ /dev/null @@ -1,2 +0,0 @@ -Record decoder (n : nat) W := { decode : W -> nat }. -Existing Class decoder. diff --git a/test-suite/bugs/closed/5012.v b/test-suite/bugs/closed/5012.v deleted file mode 100644 index 5326c0fbb1..0000000000 --- a/test-suite/bugs/closed/5012.v +++ /dev/null @@ -1,17 +0,0 @@ -Class Foo := { foo : Set }. - -Axiom admit : forall {T}, T. - -Global Instance Foo0 : Foo - := {| foo := admit |}. - -Global Instance Foo1 : Foo - := { foo := admit }. - -Existing Class Foo. - -Global Instance Foo2 : Foo - := { foo := admit }. (* Error: Unbound method name foo of class Foo. *) - -Set Warnings "+already-existing-class". -Fail Existing Class Foo. diff --git a/test-suite/bugs/closed/5019.v b/test-suite/bugs/closed/5019.v deleted file mode 100644 index 7c973f88b5..0000000000 --- a/test-suite/bugs/closed/5019.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Import Coq.ZArith.ZArith. -Goal forall (T0 : Z -> Type) (k : nat) d (P : T0 (Z.of_nat (S k)) -> Prop), P d. - clear; intros. - Timeout 1 zify. (* used to loop forever; should take < 0.01 s *) -Admitted. diff --git a/test-suite/bugs/closed/5036.v b/test-suite/bugs/closed/5036.v deleted file mode 100644 index 83f1677455..0000000000 --- a/test-suite/bugs/closed/5036.v +++ /dev/null @@ -1,10 +0,0 @@ -Section foo. - Context (F : Type -> Type). - Context (admit : forall {T}, F T = True). - Hint Rewrite (fun T => @admit T). - Lemma bad : F False. - Proof. - autorewrite with core. - constructor. - Qed. -End foo. (* Anomaly: Universe Top.16 undefined. Please report. *) diff --git a/test-suite/bugs/closed/5043.v b/test-suite/bugs/closed/5043.v deleted file mode 100644 index 4e6a0f878f..0000000000 --- a/test-suite/bugs/closed/5043.v +++ /dev/null @@ -1,8 +0,0 @@ -Unset Keep Admitted Variables. - -Section a. - Context (x : Type). - Definition foo : Type. - Admitted. -End a. -Check foo : Type. diff --git a/test-suite/bugs/closed/5045.v b/test-suite/bugs/closed/5045.v deleted file mode 100644 index dc38738d8f..0000000000 --- a/test-suite/bugs/closed/5045.v +++ /dev/null @@ -1,3 +0,0 @@ -Axiom silly : 1 = 1 -> nat -> nat. -Goal forall pf : 1 = 1, silly pf 0 = 0 -> True. - Fail generalize (@eq nat). diff --git a/test-suite/bugs/closed/5065.v b/test-suite/bugs/closed/5065.v deleted file mode 100644 index 932fee8b3b..0000000000 --- a/test-suite/bugs/closed/5065.v +++ /dev/null @@ -1,6 +0,0 @@ -Inductive foo := C1 : bar -> foo with bar := C2 : foo -> bar. - -Lemma L1 : foo -> True with L2 : bar -> True. -intros; clear L1 L2; abstract (exact I). -intros; exact I. -Qed. diff --git a/test-suite/bugs/closed/5066.v b/test-suite/bugs/closed/5066.v deleted file mode 100644 index eed7f0f3ff..0000000000 --- a/test-suite/bugs/closed/5066.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Vector. - -Fail Program Fixpoint vector_rev {A : Type} {n1 n2 : nat} (v1 : Vector.t A n1) (v2 : Vector.t A n2) : Vector.t A (n1+n2) := - match v1 with - | nil _ => v2 - | cons _ e n' sv => vector_rev sv (cons A e n2 v2) - end. diff --git a/test-suite/bugs/closed/5077.v b/test-suite/bugs/closed/5077.v deleted file mode 100644 index 7e7f2c3737..0000000000 --- a/test-suite/bugs/closed/5077.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Testing robustness of typing for a fixpoint with evars in its type *) - -Inductive foo (n : nat) : Type := . -Definition foo_denote {n} (x : foo n) : Type := match x with end. - -Definition baz : forall n (x : foo n), foo_denote x. -refine (fix go n (x : foo n) : foo_denote x := _). -Abort. diff --git a/test-suite/bugs/closed/5078.v b/test-suite/bugs/closed/5078.v deleted file mode 100644 index ca73cbcc18..0000000000 --- a/test-suite/bugs/closed/5078.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Test coercion from ident to evaluable reference *) -Tactic Notation "unfold_hyp" hyp(H) := cbv delta [H]. -Goal True -> Type. - intro H''. - Fail unfold_hyp H''. diff --git a/test-suite/bugs/closed/5093.v b/test-suite/bugs/closed/5093.v deleted file mode 100644 index 3ded4dd304..0000000000 --- a/test-suite/bugs/closed/5093.v +++ /dev/null @@ -1,11 +0,0 @@ -Axiom P : nat -> Prop. -Axiom PS : forall n, P n -> P (S n). -Axiom P0 : P 0. - -Hint Resolve PS : foobar. -Hint Resolve P0 : foobar. - -Goal P 100. -Proof. -Fail typeclasses eauto 100 with foobar. -typeclasses eauto 101 with foobar. diff --git a/test-suite/bugs/closed/5095.v b/test-suite/bugs/closed/5095.v deleted file mode 100644 index b6f38e3e84..0000000000 --- a/test-suite/bugs/closed/5095.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Checking let-in abstraction *) -Goal let x := Set in let y := x in True. - intros x y. - (* There used to have a too strict dependency test there *) - set (s := Set) in (value of x). diff --git a/test-suite/bugs/closed/5096.v b/test-suite/bugs/closed/5096.v deleted file mode 100644 index 20a537ab3c..0000000000 --- a/test-suite/bugs/closed/5096.v +++ /dev/null @@ -1,219 +0,0 @@ -Require Import Coq.FSets.FMapPositive Coq.PArith.BinPos Coq.Lists.List. - -Set Asymmetric Patterns. - -Notation eta x := (fst x, snd x). - -Inductive expr {var : Type} : Type := -| Const : expr -| LetIn : expr -> (var -> expr) -> expr. - -Definition Expr := forall var, @expr var. - -Fixpoint count_binders (e : @expr unit) : nat := -match e with -| LetIn _ eC => 1 + @count_binders (eC tt) -| _ => 0 -end. - -Definition CountBinders (e : Expr) : nat := count_binders (e _). - -Class Context (Name : Type) (var : Type) := - { ContextT : Type; - extendb : ContextT -> Name -> var -> ContextT; - empty : ContextT }. -Coercion ContextT : Context >-> Sortclass. -Arguments ContextT {_ _ _}, {_ _} _. -Arguments extendb {_ _ _} _ _ _. -Arguments empty {_ _ _}. - -Module Export Named. -Inductive expr Name : Type := -| Const : expr Name -| LetIn : Name -> expr Name -> expr Name -> expr Name. -End Named. - -Global Arguments Const {_}. -Global Arguments LetIn {_} _ _ _. - -Definition split_onames {Name : Type} (ls : list (option Name)) - : option (Name) * list (option Name) - := match ls with - | cons n ls' - => (n, ls') - | nil => (None, nil) - end. - -Section internal. - Context (InName OutName : Type) - {InContext : Context InName (OutName)} - {ReverseContext : Context OutName (InName)} - (InName_beq : InName -> InName -> bool). - - Fixpoint register_reassign (ctxi : InContext) (ctxr : ReverseContext) - (e : expr InName) (new_names : list (option OutName)) - : option (expr OutName) - := match e in Named.expr _ return option (expr _) with - | Const => Some Const - | LetIn n ex eC - => let '(n', new_names') := eta (split_onames new_names) in - match n', @register_reassign ctxi ctxr ex nil with - | Some n', Some x - => let ctxi := @extendb _ _ _ ctxi n n' in - let ctxr := @extendb _ _ _ ctxr n' n in - option_map (LetIn n' x) (@register_reassign ctxi ctxr eC new_names') - | None, Some x - => let ctxi := ctxi in - @register_reassign ctxi ctxr eC new_names' - | _, None => None - end - end. - -End internal. - -Global Instance pos_context (var : Type) : Context positive var - := { ContextT := PositiveMap.t var; - extendb ctx key v := PositiveMap.add key v ctx; - empty := PositiveMap.empty _ }. - -Global Arguments register_reassign {_ _ _ _} ctxi ctxr e _. - -Section language5. - Context (Name : Type). - - Local Notation expr := (@Top.expr Name). - Local Notation nexpr := (@Named.expr Name). - - Fixpoint ocompile (e : expr) (ls : list (option Name)) {struct e} - : option (nexpr) - := match e in @Top.expr _ return option (nexpr) with - | Top.Const => Some Named.Const - | Top.LetIn ex eC - => match @ocompile ex nil, split_onames ls with - | Some x, (Some n, ls')%core - => option_map (fun C => Named.LetIn n x C) (@ocompile (eC n) ls') - | _, _ => None - end - end. - - Definition compile (e : expr) (ls : list Name) := @ocompile e (List.map (@Some _) ls). -End language5. - -Global Arguments compile {_} e ls. - -Fixpoint merge_liveness (ls1 ls2 : list unit) := - match ls1, ls2 with - | cons x xs, cons y ys => cons tt (@merge_liveness xs ys) - | nil, ls | ls, nil => ls - end. - -Section internal1. - Context (Name : Type) - (OutName : Type) - {Context : Context Name (list unit)}. - - Definition compute_livenessf_step - (compute_livenessf : forall (ctx : Context) (e : expr Name) (prefix : list unit), list unit) - (ctx : Context) - (e : expr Name) (prefix : list unit) - : list unit - := match e with - | Const => prefix - | LetIn n ex eC - => let lx := @compute_livenessf ctx ex prefix in - let lx := merge_liveness lx (prefix ++ repeat tt 1) in - let ctx := @extendb _ _ _ ctx n (lx) in - @compute_livenessf ctx eC (prefix ++ repeat tt 1) - end. - - Fixpoint compute_liveness ctx e prefix - := @compute_livenessf_step (@compute_liveness) ctx e prefix. - - Fixpoint insert_dead_names_gen def (ls : list unit) (lsn : list OutName) - : list (option OutName) - := match ls with - | nil => nil - | cons live xs - => match lsn with - | cons n lsn' => Some n :: @insert_dead_names_gen def xs lsn' - | nil => def :: @insert_dead_names_gen def xs nil - end - end. - Definition insert_dead_names def (e : expr Name) - := insert_dead_names_gen def (compute_liveness empty e nil). -End internal1. - -Global Arguments insert_dead_names {_ _ _} def e lsn. - -Definition Let_In {A P} (x : A) (f : forall a : A, P a) : P x := let y := x in f y. - -Section language7. - Context {Context : Context unit (positive)}. - - Local Notation nexpr := (@Named.expr unit). - - Definition CompileAndEliminateDeadCode (e : Expr) (ls : list unit) - : option (nexpr) - := let e := compile (Name:=positive) (e _) (List.map Pos.of_nat (seq 1 (CountBinders e))) in - match e with - | Some e => Let_In (insert_dead_names None e ls) (* help vm_compute by factoring this out *) - (fun names => register_reassign empty empty e names) - | None => None - end. -End language7. - -Global Arguments CompileAndEliminateDeadCode {_} e ls. - -Definition ContextOn {Name1 Name2} f {var} (Ctx : Context Name1 var) : Context Name2 var - := {| ContextT := Ctx; - extendb ctx n v := extendb ctx (f n) v; - empty := empty |}. - -Definition Register := Datatypes.unit. - -Global Instance RegisterContext {var : Type} : Context Register var - := ContextOn (fun _ => 1%positive) (pos_context var). - -Definition syntax := Named.expr Register. - -Definition AssembleSyntax e ls (res := CompileAndEliminateDeadCode e ls) - := match res return match res with None => _ | _ => _ end with - | Some v => v - | None => I - end. - -Definition dummy_registers (n : nat) : list Register - := List.map (fun _ => tt) (seq 0 n). -Definition DefaultRegisters (e : Expr) : list Register - := dummy_registers (CountBinders e). - -Definition DefaultAssembleSyntax e := @AssembleSyntax e (DefaultRegisters e). - -Notation "'slet' x := A 'in' b" := (Top.LetIn A (fun x => b)) (at level 200, b at level 200). -Notation "#[ var ]#" := (@Top.Const var). - -Definition compiled_syntax : Expr := fun (var : Type) => -( - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - @Top.Const var). - -Definition v := - Eval cbv [compiled_syntax] in (DefaultAssembleSyntax (compiled_syntax)). - -Timeout 2 Eval vm_compute in v. diff --git a/test-suite/bugs/closed/5097.v b/test-suite/bugs/closed/5097.v deleted file mode 100644 index 37b239cf61..0000000000 --- a/test-suite/bugs/closed/5097.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Tracing existing evars along the weakening rule ("clear") *) -Goal forall y, exists x, x=0->x=y. -intros. -eexists ?[x]. -intros. -let x:=constr:(ltac:(clear y; exact 0)) in idtac x. -Abort. diff --git a/test-suite/bugs/closed/5123.v b/test-suite/bugs/closed/5123.v deleted file mode 100644 index 17231bffcf..0000000000 --- a/test-suite/bugs/closed/5123.v +++ /dev/null @@ -1,33 +0,0 @@ -(* IN 8.5pl2 and 8.6 (4da2131), the following shows different typeclass resolution behaviors following an unshelve tactical vs. an Unshelve command: *) - -(*Pose an open constr to prevent immediate typeclass resolution in holes:*) -Tactic Notation "opose" open_constr(x) "as" ident(H) := pose x as H. - -Inductive vect A : nat -> Type := -| vnil : vect A 0 -| vcons : forall (h:A) (n:nat), vect A n -> vect A (S n). - -Class Eqdec A := eqdec : forall a b : A, {a=b}+{a<>b}. - -Require Bool. - -Instance Bool_eqdec : Eqdec bool := Bool.bool_dec. - -Context `{vect_sigT_eqdec : forall A : Type, Eqdec A -> Eqdec {a : nat & vect A a}}. - -Typeclasses eauto := debug. - -Goal True. - unshelve opose (@vect_sigT_eqdec _ _ _ _) as H. - all:cycle 2. - eapply existT. (*BUG: Why does this do typeclass resolution in the evar?*) - Focus 5. -Abort. - -Goal True. - opose (@vect_sigT_eqdec _ _ _ _) as H. - Unshelve. - all:cycle 3. - eapply existT. (*This does no typeclass resultion, which is correct.*) - Focus 5. -Abort. diff --git a/test-suite/bugs/closed/5127.v b/test-suite/bugs/closed/5127.v deleted file mode 100644 index 831e8fb507..0000000000 --- a/test-suite/bugs/closed/5127.v +++ /dev/null @@ -1,15 +0,0 @@ -Fixpoint arrow (n: nat) := - match n with - | S n => bool -> arrow n - | O => bool - end. - -Fixpoint apply (n : nat) : arrow n -> bool := - match n return arrow n -> bool with - | S n => fun f => apply _ (f true) - | O => fun x => x - end. - -Axiom f : arrow 10000. -Definition v : bool := Eval compute in apply _ f. -Definition w : bool := Eval vm_compute in v. diff --git a/test-suite/bugs/closed/5145.v b/test-suite/bugs/closed/5145.v deleted file mode 100644 index 0533d21e0c..0000000000 --- a/test-suite/bugs/closed/5145.v +++ /dev/null @@ -1,10 +0,0 @@ -Class instructions := - { - W : Type; - ldi : nat -> W - }. - -Fail Definition foo := - let y2 := ldi 0 in - let '(CF, _) := (true, 0) in - y2. diff --git a/test-suite/bugs/closed/5149.v b/test-suite/bugs/closed/5149.v deleted file mode 100644 index 684dba1961..0000000000 --- a/test-suite/bugs/closed/5149.v +++ /dev/null @@ -1,47 +0,0 @@ -Goal forall x x' : nat, x = x' -> S x = S x -> exists y, S y = S x. -intros. -eexists. -rewrite <- H. -eassumption. -Qed. - -Goal forall (base_type_code : Type) (t : base_type_code) (flat_type : Type) - (t' : flat_type) (exprf interp_flat_type0 interp_flat_type1 : -flat_type -> Type) - (v v' : interp_flat_type1 t'), - v = v' -> - forall (interpf : forall t0 : flat_type, exprf t0 -> interp_flat_type1 t0) - (SmartVarVar : forall t0 : flat_type, interp_flat_type1 t0 -> -interp_flat_type0 t0) - (Tbase : base_type_code -> flat_type) (x : exprf (Tbase t)) - (x' : interp_flat_type1 (Tbase t)) (T : Type) - (flatten_binding_list : forall t0 : flat_type, - interp_flat_type0 t0 -> interp_flat_type1 t0 -> list T) - (P : T -> list T -> Prop) (prod : Type -> Type -> Type) - (s : forall x0 : base_type_code, prod (exprf (Tbase x0)) -(interp_flat_type1 (Tbase x0)) -> T) - (pair : forall A B : Type, A -> B -> prod A B), - P (s t (pair (exprf (Tbase t)) (interp_flat_type1 (Tbase t)) x x')) - (flatten_binding_list t' (SmartVarVar t' v') v) -> - (forall (t0 : base_type_code) (t'0 : flat_type) (v0 : interp_flat_type1 -t'0) - (x0 : exprf (Tbase t0)) (x'0 : interp_flat_type1 (Tbase t0)), - P (s t0 (pair (exprf (Tbase t0)) (interp_flat_type1 (Tbase t0)) x0 -x'0)) - (flatten_binding_list t'0 (SmartVarVar t'0 v0) v0) -> interpf -(Tbase t0) x0 = x'0) -> - interpf (Tbase t) x = x'. -Proof. - intros ?????????????????????? interpf_SmartVarVar. - solve [ unshelve (subst; eapply interpf_SmartVarVar; eassumption) ] || fail -"too early". - Undo. - (** Implicitely at the dot. The first fails because unshelve adds a goal, and solve hence fails. The second has an ambiant unification problem that is solved after solve *) - Fail solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption) ]. - solve [eapply interpf_SmartVarVar; subst; eassumption]. - Undo. - Unset Solve Unification Constraints. - (* User control of when constraints are solved *) - solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption); solve_constraints ]. -Qed. - diff --git a/test-suite/bugs/closed/5153.v b/test-suite/bugs/closed/5153.v deleted file mode 100644 index be6407b5fa..0000000000 --- a/test-suite/bugs/closed/5153.v +++ /dev/null @@ -1,8 +0,0 @@ -(* An example where it does not hurt having more type-classes resolution *) -Class some_type := { Ty : Type }. -Instance: some_type := { Ty := nat }. -Arguments Ty : clear implicits. -Goal forall (H : forall t : some_type, @Ty t -> False) (H' : False -> 1 = 2), 1 = 2. -Proof. -intros H H'. -specialize (H' (@H _ O)). (* was failing *) diff --git a/test-suite/bugs/closed/5161.v b/test-suite/bugs/closed/5161.v deleted file mode 100644 index d28303b8ab..0000000000 --- a/test-suite/bugs/closed/5161.v +++ /dev/null @@ -1,27 +0,0 @@ -(* Check that the presence of binders with type annotation do not - prevent the recursive binder part to be found *) - -From Coq Require Import Utf8. - -Delimit Scope C_scope with C. -Global Open Scope C_scope. - -Delimit Scope uPred_scope with I. - -Definition FORALL {T : Type} (f : T → Prop) : Prop := ∀ x, f x. - -Notation "∀ x .. y , P" := - (FORALL (λ x, .. (FORALL (λ y, P)) ..)%I) - (at level 200, x binder, y binder, right associativity) : uPred_scope. -Infix "∧" := and : uPred_scope. - -(* The next command fails with - In recursive notation with binders, Φ is expected to come without type. - I would expect this notation to work fine, since the ∀ does support - type annotation. -*) -Notation "'{{{' P } } } e {{{ x .. y ; pat , Q } } }" := - (∀ Φ : _ → _, - (∀ x, .. (∀ y, Q ∧ Φ pat) .. ))%I - (at level 20, x closed binder, y closed binder, - format "{{{ P } } } e {{{ x .. y ; pat , Q } } }") : uPred_scope. diff --git a/test-suite/bugs/closed/5177.v b/test-suite/bugs/closed/5177.v deleted file mode 100644 index 7c8af1e46e..0000000000 --- a/test-suite/bugs/closed/5177.v +++ /dev/null @@ -1,22 +0,0 @@ -(* Bug 5177 https://coq.inria.fr/bug/5177 : - Extraction and module type containing application and "with" *) - -Module Type T. - Parameter t: Type. -End T. - -Module Type A (MT: T). - Parameter t1: Type. - Parameter t2: Type. - Parameter bar: MT.t -> t1 -> t2. -End A. - -Module MakeA(MT: T): A MT with Definition t1 := nat. - Definition t1 := nat. - Definition t2 := nat. - Definition bar (m: MT.t) (x:t1) := x. -End MakeA. - -Require Extraction. -Recursive Extraction MakeA. -Extraction TestCompile MakeA. diff --git a/test-suite/bugs/closed/5180.v b/test-suite/bugs/closed/5180.v deleted file mode 100644 index 05603a048c..0000000000 --- a/test-suite/bugs/closed/5180.v +++ /dev/null @@ -1,64 +0,0 @@ -Universes a b c ω ω'. -Definition Typeω := Type@{ω}. -Definition Type2 : Typeω := Type@{c}. -Definition Type1 : Type2 := Type@{b}. -Definition Type0 : Type1 := Type@{a}. - -Set Universe Polymorphism. -Set Printing Universes. - -Definition Typei' (n : nat) - := match n return Type@{ω'} with - | 0 => Type0 - | 1 => Type1 - | 2 => Type2 - | _ => Typeω - end. -Definition TypeOfTypei' {n} (x : Typei' n) : Type@{ω'} - := match n return Typei' n -> Type@{ω'} with - | 0 | 1 | 2 | _ => fun x => x - end x. -Definition Typei (n : nat) : Typei' (S n) - := match n return Typei' (S n) with - | 0 => Type0 - | 1 => Type1 - | _ => Type2 - end. -Definition TypeOfTypei {n} (x : TypeOfTypei' (Typei n)) : Type@{ω'} - := match n return TypeOfTypei' (Typei n) -> Type@{ω'} with - | 0 | 1 | _ => fun x => x - end x. -Check Typei 0 : Typei 1. -Check Typei 1 : Typei 2. - -Definition lift' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) - := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with - | 0 | 1 | 2 | _ => fun x => (x : Type) - end. -Definition lift'' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) - := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with - | 0 | 1 | 2 | _ => fun x => x - end. (* The command has indeed failed with message: -In environment -n : nat -x : TypeOfTypei' (Typei 0) -The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type - "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because a < b). - *) -Check (fun x : TypeOfTypei' (Typei 0) => TypeOfTypei' (Typei 1)). - -Definition lift''' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)). - refine match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with - | 0 | 1 | 2 | _ => fun x => _ - end. - exact x. - Undo. - (* The command has indeed failed with message: -In environment -n : nat -x : TypeOfTypei' (Typei 0) -The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type - "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because a < b). - *) - all:compute in *. - all:exact x. diff --git a/test-suite/bugs/closed/5181.v b/test-suite/bugs/closed/5181.v deleted file mode 100644 index 0e6d471979..0000000000 --- a/test-suite/bugs/closed/5181.v +++ /dev/null @@ -1,3 +0,0 @@ -Definition foo (x y : nat) := x. -Fail Arguments foo {_} : assert. - diff --git a/test-suite/bugs/closed/5188.v b/test-suite/bugs/closed/5188.v deleted file mode 100644 index e29ebfb4ec..0000000000 --- a/test-suite/bugs/closed/5188.v +++ /dev/null @@ -1,5 +0,0 @@ -Set Printing All. -Axiom relation : forall (T : Type), Set. -Axiom T : forall A (R : relation A), Set. -Set Printing Universes. -Parameter (A:_) (R:_) (e:@T A R). diff --git a/test-suite/bugs/closed/5193.v b/test-suite/bugs/closed/5193.v deleted file mode 100644 index cc8739afe6..0000000000 --- a/test-suite/bugs/closed/5193.v +++ /dev/null @@ -1,14 +0,0 @@ -Class Eqdec A := eqdec : forall a b : A, {a=b}+{a<>b}. - -Typeclasses eauto := debug. -Set Typeclasses Debug Verbosity 2. - -Inductive Finx(n : nat) : Set := -| Fx1(i : nat)(e : n = S i) -| FxS(i : nat)(f : Finx i)(e : n = S i). - -Context `{Finx_eqdec : forall n, Eqdec (Finx n)}. - -Goal {x : Type & Eqdec x}. - eexists. - try typeclasses eauto 1 with typeclass_instances. diff --git a/test-suite/bugs/closed/5198.v b/test-suite/bugs/closed/5198.v deleted file mode 100644 index 72722f5f6d..0000000000 --- a/test-suite/bugs/closed/5198.v +++ /dev/null @@ -1,39 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-boot" "-nois") -*- *) -(* File reduced by coq-bug-finder from original input, then from 286 lines to -27 lines, then from 224 lines to 53 lines, then from 218 lines to 56 lines, -then from 269 lines to 180 lines, then from 132 lines to 48 lines, then from -253 lines to 65 lines, then from 79 lines to 65 lines *) -(* coqc version 8.6.0 (November 2016) compiled on Nov 12 2016 14:43:52 with -OCaml 4.02.3 - coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-v8.6,v8.6 -(7e992fa784ee6fa48af8a2e461385c094985587d) *) -Axiom admit : forall {T}, T. -Set Printing Implicit. -Inductive nat := O | S (_ : nat). -Axiom f : forall (_ _ : nat), nat. -Class ZLikeOps (e : nat) - := { LargeT : Type ; SmallT : Type ; CarryAdd : forall (_ _ : LargeT), LargeT -}. -Class BarrettParameters := - { b : nat ; k : nat ; ops : ZLikeOps (f b k) }. -Axiom barrett_reduce_function_bundled : forall {params : BarrettParameters} - (_ : @LargeT _ (@ops params)), - @SmallT _ (@ops params). - -Global Instance ZZLikeOps e : ZLikeOps (f (S O) e) - := { LargeT := nat ; SmallT := nat ; CarryAdd x y := y }. -Definition SRep := nat. -Local Instance x86_25519_Barrett : BarrettParameters - := { b := S O ; k := O ; ops := ZZLikeOps O }. -Definition SRepAdd : forall (_ _ : SRep), SRep - := let v := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)) in - v. -Definition SRepAdd' : forall (_ _ : SRep), SRep - := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)). -(* Error: -In environment -x : SRep -y : SRep -The term "x" has type "SRep" while it is expected to have type - "@LargeT ?e ?ZLikeOps". - *) diff --git a/test-suite/bugs/closed/5203.v b/test-suite/bugs/closed/5203.v deleted file mode 100644 index 3428e1a450..0000000000 --- a/test-suite/bugs/closed/5203.v +++ /dev/null @@ -1,5 +0,0 @@ -Goal True. - Typeclasses eauto := debug. - Fail solve [ typeclasses eauto ]. - Fail typeclasses eauto. - diff --git a/test-suite/bugs/closed/5205.v b/test-suite/bugs/closed/5205.v deleted file mode 100644 index 406f37a4b1..0000000000 --- a/test-suite/bugs/closed/5205.v +++ /dev/null @@ -1,6 +0,0 @@ -Definition foo (n : nat) (m : nat) : nat := m. - -Arguments foo {_} _, _ _. - -Check foo 1 1. -Check foo (n:=1) 1. diff --git a/test-suite/bugs/closed/5208.v b/test-suite/bugs/closed/5208.v deleted file mode 100644 index b7a684a27c..0000000000 --- a/test-suite/bugs/closed/5208.v +++ /dev/null @@ -1,222 +0,0 @@ -Require Import Program. - -Require Import Coq.Strings.String. -Require Import Coq.Strings.Ascii. -Require Import Coq.Numbers.BinNums. - -Set Implicit Arguments. -Set Strict Implicit. -Set Universe Polymorphism. -Set Printing Universes. - -Local Open Scope positive. - -Definition field : Type := positive. - -Section poly. - Universe U. - - Inductive fields : Type := - | pm_Leaf : fields - | pm_Branch : fields -> option Type@{U} -> fields -> fields. - - Definition fields_left (f : fields) : fields := - match f with - | pm_Leaf => pm_Leaf - | pm_Branch l _ _ => l - end. - - Definition fields_right (f : fields) : fields := - match f with - | pm_Leaf => pm_Leaf - | pm_Branch _ _ r => r - end. - - Definition fields_here (f : fields) : option Type@{U} := - match f with - | pm_Leaf => None - | pm_Branch _ s _ => s - end. - - Fixpoint fields_get (p : field) (m : fields) {struct p} : option Type@{U} := - match p with - | xH => match m with - | pm_Leaf => None - | pm_Branch _ x _ => x - end - | xO p' => fields_get p' match m with - | pm_Leaf => pm_Leaf - | pm_Branch L _ _ => L - end - | xI p' => fields_get p' match m with - | pm_Leaf => pm_Leaf - | pm_Branch _ _ R => R - end - end. - - Definition fields_leaf : fields := pm_Leaf. - - Inductive member (val : Type@{U}) : fields -> Type := - | pmm_H : forall L R, member val (pm_Branch L (Some val) R) - | pmm_L : forall (V : option Type@{U}) L R, member val L -> member val (pm_Branch L V R) - | pmm_R : forall (V : option Type@{U}) L R, member val R -> member val (pm_Branch L V R). - Arguments pmm_H {_ _ _}. - Arguments pmm_L {_ _ _ _} _. - Arguments pmm_R {_ _ _ _} _. - - Fixpoint get_member (val : Type@{U}) p {struct p} - : forall m, fields_get p m = @Some Type@{U} val -> member val m := - match p as p return forall m, fields_get p m = @Some Type@{U} val -> member@{U} val m with - | xH => fun m => - match m as m return fields_get xH m = @Some Type@{U} val -> member@{U} val m with - | pm_Leaf => fun pf : None = @Some Type@{U} _ => - match pf in _ = Z return match Z with - | Some _ => _ - | None => unit - end - with - | eq_refl => tt - end - | pm_Branch _ None _ => fun pf : None = @Some Type@{U} _ => - match pf in _ = Z return match Z with - | Some _ => _ - | None => unit - end - with - | eq_refl => tt - end - | pm_Branch _ (Some x) _ => fun pf : @Some Type@{U} x = @Some Type@{U} val => - match eq_sym pf in _ = Z return member@{U} val (pm_Branch _ Z _) with - | eq_refl => pmm_H - end - end - | xO p' => fun m => - match m as m return fields_get (xO p') m = @Some Type@{U} val -> member@{U} val m with - | pm_Leaf => fun pf : fields_get p' pm_Leaf = @Some Type@{U} val => - @get_member _ p' pm_Leaf pf - | pm_Branch l _ _ => fun pf : fields_get p' l = @Some Type@{U} val => - @pmm_L _ _ _ _ (@get_member _ p' l pf) - end - | xI p' => fun m => - match m as m return fields_get (xI p') m = @Some Type@{U} val -> member@{U} val m with - | pm_Leaf => fun pf : fields_get p' pm_Leaf = @Some Type@{U} val => - @get_member _ p' pm_Leaf pf - | pm_Branch l _ r => fun pf : fields_get p' r = @Some Type@{U} val => - @pmm_R _ _ _ _ (@get_member _ p' r pf) - end - end. - - Inductive record : fields -> Type := - | pr_Leaf : record pm_Leaf - | pr_Branch : forall L R (V : option Type@{U}), - record L -> - match V return Type@{U} with - | None => unit - | Some t => t - end -> - record R -> - record (pm_Branch L V R). - - - Definition record_left {L} {V : option Type@{U}} {R} - (r : record (pm_Branch L V R)) : record L := - match r in record z - return match z with - | pm_Branch L _ _ => record L - | _ => unit - end - with - | pr_Branch _ l _ _ => l - | pr_Leaf => tt - end. -Set Printing All. - Definition record_at {L} {V : option Type@{U}} {R} (r : record (pm_Branch L V R)) - : match V return Type@{U} with - | None => unit - | Some t => t - end := - match r in record z - return match z (* return ?X *) with - | pm_Branch _ V _ => match V return Type@{U} with - | None => unit - | Some t => t - end - | _ => unit - end - with - | pr_Branch _ _ v _ => v - | pr_Leaf => tt - end. - - Definition record_here {L : fields} (v : Type@{U}) {R : fields} - (r : record (pm_Branch L (@Some Type@{U} v) R)) : v := - match r in record z - return match z return Type@{U} with - | pm_Branch _ (Some v) _ => v - | _ => unit - end - with - | pr_Branch _ _ v _ => v - | pr_Leaf => tt - end. - - Definition record_right {L V R} (r : record (pm_Branch L V R)) : record R := - match r in record z return match z with - | pm_Branch _ _ R => record R - | _ => unit - end - with - | pr_Branch _ _ _ r => r - | pr_Leaf => tt - end. - - Fixpoint record_get {val : Type@{U}} {pm : fields} (m : member val pm) : record pm -> val := - match m in member _ pm return record pm -> val with - | pmm_H => fun r => record_here r - | pmm_L m' => fun r => record_get m' (record_left r) - | pmm_R m' => fun r => record_get m' (record_right r) - end. - - Fixpoint record_set {val : Type@{U}} {pm : fields} (m : member val pm) (x : val) {struct m} - : record pm -> record pm := - match m in member _ pm return record pm -> record pm with - | pmm_H => fun r => - pr_Branch (Some _) - (record_left r) - x - (record_right r) - | pmm_L m' => fun r => - pr_Branch _ - (record_set m' x (record_left r)) - (record_at r) - (record_right r) - | pmm_R m' => fun r => - pr_Branch _ (record_left r) - (record_at r) - (record_set m' x (record_right r)) - end. -End poly. -Axiom cheat : forall {A}, A. -Lemma record_get_record_set_different: - forall (T: Type) (vars: fields) - (pmr pmw: member T vars) - (diff: pmr <> pmw) - (r: record vars) (val: T), - record_get pmr (record_set pmw val r) = record_get pmr r. -Proof. - intros. - revert pmr diff r val. - induction pmw; simpl; intros. - - dependent destruction pmr. - + congruence. - + auto. - + auto. - - dependent destruction pmr. - + auto. - + simpl. apply IHpmw. congruence. - + auto. - - dependent destruction pmr. - + auto. - + auto. - + simpl. apply IHpmw. congruence. -Qed. diff --git a/test-suite/bugs/closed/5215.v b/test-suite/bugs/closed/5215.v deleted file mode 100644 index ecf5291596..0000000000 --- a/test-suite/bugs/closed/5215.v +++ /dev/null @@ -1,286 +0,0 @@ -Require Import Coq.Logic.FunctionalExtensionality. -Require Import Coq.Program.Tactics. - -Global Set Primitive Projections. - -Global Set Universe Polymorphism. - -Global Unset Universe Minimization ToSet. - -Class Category : Type := -{ - Obj : Type; - Hom : Obj -> Obj -> Type; - compose : forall {a b c : Obj}, (Hom a b) -> (Hom b c) -> (Hom a c); - id : forall {a : Obj}, Hom a a; -}. - -Arguments Obj {_}, _. -Arguments id {_ _}, {_} _, _ _. -Arguments Hom {_} _ _, _ _ _. -Arguments compose {_} {_ _ _} _ _, _ {_ _ _} _ _, _ _ _ _ _ _. - -Coercion Obj : Category >-> Sortclass. - -Definition Opposite (C : Category) : Category := -{| - - Obj := Obj C; - Hom := fun a b => Hom b a; - compose := - fun a b c (f : Hom b a) (g : Hom c b) => compose C c b a g f; - id := fun c => id C c; -|}. - -Record Functor (C C' : Category) : Type := -{ - FO : C -> C'; - FA : forall {a b}, Hom a b -> Hom (FO a) (FO b); -}. - -Arguments FO {_ _} _ _. -Arguments FA {_ _} _ {_ _} _, {_ _} _ _ _ _. - -Section Opposite_Functor. - Context {C D : Category} (F : Functor C D). - - Program Definition Opposite_Functor : (Functor (Opposite C) (Opposite D)) := - {| - FO := FO F; - FA := fun _ _ h => FA F h; - |}. - -End Opposite_Functor. - -Section Functor_Compose. - Context {C C' C'' : Category} (F : Functor C C') (F' : Functor C' C''). - - Program Definition Functor_compose : Functor C C'' := - {| - FO := fun c => FO F' (FO F c); - FA := fun c d f => FA F' (FA F f) - |}. - -End Functor_Compose. - -Section Algebras. - Context {C : Category} (T : Functor C C). - Record Algebra : Type := - { - Alg_Carrier : C; - Constructors : Hom (FO T Alg_Carrier) Alg_Carrier - }. - - Record Algebra_Hom (alg alg' : Algebra) : Type := - { - Alg_map : Hom (Alg_Carrier alg) (Alg_Carrier alg'); - - Alg_map_com : compose (FA T Alg_map) (Constructors alg') - = compose (Constructors alg) Alg_map - }. - - Arguments Alg_map {_ _} _. - Arguments Alg_map_com {_ _} _. - Program Definition Algebra_Hom_compose - {alg alg' alg'' : Algebra} - (h : Algebra_Hom alg alg') - (h' : Algebra_Hom alg' alg'') - : Algebra_Hom alg alg'' - := - {| - Alg_map := compose (Alg_map h) (Alg_map h') - |}. - - Next Obligation. Proof. Admitted. - - Lemma Algebra_Hom_eq_simplify (alg alg' : Algebra) - (ah ah' : Algebra_Hom alg alg') - : (Alg_map ah) = (Alg_map ah') -> ah = ah'. - Proof. Admitted. - - Program Definition Algebra_Hom_id (alg : Algebra) : Algebra_Hom alg alg := - {| - Alg_map := id - |}. - - Next Obligation. Admitted. - - Definition Algebra_Cat : Category := - {| - Obj := Algebra; - Hom := Algebra_Hom; - compose := @Algebra_Hom_compose; - id := Algebra_Hom_id; - |}. - -End Algebras. - -Arguments Alg_Carrier {_ _} _. -Arguments Constructors {_ _} _. -Arguments Algebra_Hom {_ _} _ _. -Arguments Alg_map {_ _ _ _} _. -Arguments Alg_map_com {_ _ _ _} _. -Arguments Algebra_Hom_id {_ _} _. - -Section CoAlgebras. - Context {C : Category}. - - Definition CoAlgebra (T : Functor C C) := - @Algebra (Opposite C) (Opposite_Functor T). - - Definition CoAlgebra_Hom {T : Functor C C} := - @Algebra_Hom (Opposite C) (Opposite_Functor T). - - Definition CoAlgebra_Hom_id {T : Functor C C} := - @Algebra_Hom_id (Opposite C) (Opposite_Functor T). - - Definition CoAlgebra_Cat (T : Functor C C) := - @Algebra_Cat (Opposite C) (Opposite_Functor T). - -End CoAlgebras. - -Program Definition Type_Cat : Category := -{| - Obj := Type; - Hom := (fun A B => A -> B); - compose := fun A B C (g : A -> B) (h : B -> C) => fun (x : A) => h (g x); - id := fun A => fun x => x -|}. - -Local Obligation Tactic := idtac. - -Program Definition Prod_Cat (C C' : Category) : Category := -{| - Obj := C * C'; - Hom := - fun a b => - ((Hom (fst a) (fst b)) * (Hom (snd a) (snd b)))%type; - compose := - fun a b c f g => - ((compose (fst f) (fst g)), (compose (snd f)(snd g))); - id := fun c => (id, id) -|}. - -Class Terminal (C : Category) : Type := -{ - terminal : C; - t_morph : forall (d : Obj), Hom d terminal; - t_morph_unique : forall (d : Obj) (f g : (Hom d terminal)), f = g -}. - -Arguments terminal {_} _. -Arguments t_morph {_} _ _. -Arguments t_morph_unique {_} _ _ _ _. - -Coercion terminal : Terminal >-> Obj. - -Definition Initial (C : Category) := Terminal (Opposite C). -Existing Class Initial. - -Record Product {C : Category} (c d : C) : Type := -{ - product : C; - Pi_1 : Hom product c; - Pi_2 : Hom product d; - Prod_morph_ex : forall (p' : Obj) (r1 : Hom p' c) (r2 : Hom p' d), (Hom p' product); -}. - -Arguments Product _ _ _, {_} _ _. - -Arguments Pi_1 {_ _ _ _}, {_ _ _} _. -Arguments Pi_2 {_ _ _ _}, {_ _ _} _. -Arguments Prod_morph_ex {_ _ _} _ _ _ _. - -Coercion product : Product >-> Obj. - -Definition Has_Products (C : Category) : Type := forall a b, Product a b. - -Existing Class Has_Products. - -Program Definition Prod_Func (C : Category) {HP : Has_Products C} - : Functor (Prod_Cat C C) C := -{| - FO := fun x => HP (fst x) (snd x); - FA := fun a b f => Prod_morph_ex _ _ (compose Pi_1 (fst f)) (compose Pi_2 (snd f)) -|}. - -Arguments Prod_Func _ _, _ {_}. - -Definition Sum (C : Category) := @Product (Opposite C). - -Arguments Sum _ _ _, {_} _ _. - -Definition Has_Sums (C : Category) : Type := forall (a b : C), (Sum a b). - -Existing Class Has_Sums. - -Program Definition sum_Sum (A B : Type) : (@Sum Type_Cat A B) := -{| - product := (A + B)%type; - Prod_morph_ex := - fun (p' : Type) - (r1 : A -> p') - (r2 : B -> p') - (X : A + B) => - match X return p' with - | inl a => r1 a - | inr b => r2 b - end -|}. -Next Obligation. simpl; auto. Defined. -Next Obligation. simpl; auto. Defined. - -Program Instance Type_Cat_Has_Sums : Has_Sums Type_Cat := sum_Sum. - -Definition Sum_Func {C : Category} {HS : Has_Sums C} : - Functor (Prod_Cat C C) C := Opposite_Functor (Prod_Func (Opposite C) HS). - -Arguments Sum_Func _ _, _ {_}. - -Program Instance unit_Type_term : Terminal Type_Cat := -{ - terminal := unit; - t_morph := fun _ _=> tt -}. - -Next Obligation. Proof. Admitted. - -Program Definition term_id : Functor Type_Cat (Prod_Cat Type_Cat Type_Cat) := -{| - FO := fun a => (@terminal Type_Cat _, a); - FA := fun a b f => (@id _ (@terminal Type_Cat _), f) -|}. - -Definition S_nat_func : Functor Type_Cat Type_Cat := - Functor_compose term_id (Sum_Func Type_Cat _). - -Definition S_nat_alg_cat := Algebra_Cat S_nat_func. - -CoInductive CoNat : Set := - | CoO : CoNat - | CoS : CoNat -> CoNat -. - -Definition S_nat_coalg_cat := @CoAlgebra_Cat Type_Cat S_nat_func. - -Set Printing Universes. -Program Definition CoNat_alg_term : Initial S_nat_coalg_cat := -{| - terminal := _; - t_morph := _ -|}. - -Next Obligation. Admitted. -Next Obligation. Admitted. - -Axiom Admit : False. - -Next Obligation. -Proof. - intros d f g. - assert(H1 := (@Alg_map_com _ _ _ _ f)). clear. - assert (inl tt = inr tt) by (exfalso; apply Admit). - discriminate. - all: exfalso; apply Admit. - Show Universes. -Qed. diff --git a/test-suite/bugs/closed/5215_2.v b/test-suite/bugs/closed/5215_2.v deleted file mode 100644 index 399947f00f..0000000000 --- a/test-suite/bugs/closed/5215_2.v +++ /dev/null @@ -1,8 +0,0 @@ -Require Import Coq.Program.Tactics. -Set Universe Polymorphism. -Set Printing Universes. -Definition typ := Type. - -Program Definition foo : typ := _ -> _. -Next Obligation. Admitted. -Next Obligation. exact typ. Show Proof. Show Universes. Defined. diff --git a/test-suite/bugs/closed/5219.v b/test-suite/bugs/closed/5219.v deleted file mode 100644 index f7cec1a0cf..0000000000 --- a/test-suite/bugs/closed/5219.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Test surgical use of beta-iota in the type of variables coming from - pattern-matching for refine *) - -Goal forall x : sigT (fun x => x = 1), True. - intro x; refine match x with - | existT _ x' e' => _ - end. - lazymatch goal with - | [ H : _ = _ |- _ ] => idtac - end. diff --git a/test-suite/bugs/closed/5233.v b/test-suite/bugs/closed/5233.v deleted file mode 100644 index 06286c740d..0000000000 --- a/test-suite/bugs/closed/5233.v +++ /dev/null @@ -1,2 +0,0 @@ -(* Implicit arguments on type were missing for recursive records *) -Inductive foo {A : Type} : Type := { Foo : foo }. diff --git a/test-suite/bugs/closed/5245.v b/test-suite/bugs/closed/5245.v deleted file mode 100644 index e5bca5b5e4..0000000000 --- a/test-suite/bugs/closed/5245.v +++ /dev/null @@ -1,18 +0,0 @@ -Set Primitive Projections. - -Record foo := Foo { - foo_car : Type; - foo_rel : foo_car -> foo_car -> Prop -}. -Arguments foo_rel : simpl never. - -Definition foo_fun {A B} := Foo (A -> B) (fun f g => forall x, f x = g x). - -Goal @foo_rel foo_fun (fun x : nat => x) (fun x => x). -Proof. -intros x; exact eq_refl. -Undo. -progress hnf; intros; exact eq_refl. -Undo. -unfold foo_rel. intros x. exact eq_refl. -Qed. diff --git a/test-suite/bugs/closed/5255.v b/test-suite/bugs/closed/5255.v deleted file mode 100644 index 5daaf9edbf..0000000000 --- a/test-suite/bugs/closed/5255.v +++ /dev/null @@ -1,24 +0,0 @@ -Section foo. - Context (x := 1). - Definition foo : x = 1 := eq_refl. -End foo. - -Module Type Foo. - Context (x := 1). - Definition foo : x = 1 := eq_refl. -End Foo. - -Set Universe Polymorphism. - -Inductive unit := tt. -Inductive eq {A} (x y : A) : Type := eq_refl : eq x y. - -Section bar. - Context (x := tt). - Definition bar : eq x tt := eq_refl _ _. -End bar. - -Module Type Bar. - Context (x := tt). - Definition bar : eq x tt := eq_refl _ _. -End Bar. diff --git a/test-suite/bugs/closed/5277.v b/test-suite/bugs/closed/5277.v deleted file mode 100644 index 7abc38bfce..0000000000 --- a/test-suite/bugs/closed/5277.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Scheme Equality not robust wrt names *) - -Module A1. - Inductive A (T : Type) := C (a : T). - Scheme Equality for A. (* success *) -End A1. - -Module A2. - Inductive A (x : Type) := C (a : x). - Scheme Equality for A. -End A2. diff --git a/test-suite/bugs/closed/5281.v b/test-suite/bugs/closed/5281.v deleted file mode 100644 index 03bafdc9ae..0000000000 --- a/test-suite/bugs/closed/5281.v +++ /dev/null @@ -1,6 +0,0 @@ -Inductive A (T : Prop) := B (_ : T). -Scheme Equality for A. - -Goal forall (T:Prop), (forall x y : T, {x=y}+{x<>y}) -> forall x y : A T, {x=y}+{x<>y}. -decide equality. -Qed. diff --git a/test-suite/bugs/closed/5286.v b/test-suite/bugs/closed/5286.v deleted file mode 100644 index 98d4e5c968..0000000000 --- a/test-suite/bugs/closed/5286.v +++ /dev/null @@ -1,9 +0,0 @@ -Set Primitive Projections. - -CoInductive R := mkR { p : unit }. - -CoFixpoint foo := mkR tt. - -Check (eq_refl tt : p foo = tt). -Check (eq_refl tt <: p foo = tt). -Check (eq_refl tt <<: p foo = tt). diff --git a/test-suite/bugs/closed/5300.v b/test-suite/bugs/closed/5300.v deleted file mode 100644 index 18202df508..0000000000 --- a/test-suite/bugs/closed/5300.v +++ /dev/null @@ -1,39 +0,0 @@ -Module Test1. - - Module Type Foo. - Parameter t : unit. - End Foo. - - Module Bar : Foo. - Module Type Rnd. Definition t' : unit := tt. End Rnd. - Module Rnd_inst : Rnd. Definition t' : unit := tt. End Rnd_inst. - Definition t : unit. - exact Rnd_inst.t'. - Qed. - End Bar. - - Print Assumptions Bar.t. -End Test1. - -Module Test2. - Module Type Foo. - Parameter t1 : unit. - Parameter t2 : unit. - End Foo. - - Module Bar : Foo. - Inductive ind := . - Definition t' : unit := tt. - Definition t1 : unit. - Proof. - exact ((fun (_ : ind -> False) => tt) (fun H => match H with end)). - Qed. - Definition t2 : unit. - Proof. - exact t'. - Qed. - End Bar. - - Print Assumptions Bar.t1. - Print Assumptions Bar.t1. -End Test2. diff --git a/test-suite/bugs/closed/5315.v b/test-suite/bugs/closed/5315.v deleted file mode 100644 index d8824bff87..0000000000 --- a/test-suite/bugs/closed/5315.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import Recdef. - -Function dumb_works (a:nat) {struct a} := - match (fun x => x) a with O => O | S n' => dumb_works n' end. - -Function dumb_nope (a:nat) {struct a} := - match (id (fun x => x)) a with O => O | S n' => dumb_nope n' end. - -(* This check is just present to ensure Function worked well *) -Check R_dumb_nope_complete. diff --git a/test-suite/bugs/closed/5321.v b/test-suite/bugs/closed/5321.v deleted file mode 100644 index 03514e23b1..0000000000 --- a/test-suite/bugs/closed/5321.v +++ /dev/null @@ -1,18 +0,0 @@ -Definition proj1_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v) - : proj1_sig u = proj1_sig v - := f_equal (@proj1_sig _ _) p. - -Definition proj2_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v) - : eq_rect _ _ (proj2_sig u) _ (proj1_sig_path p) = proj2_sig v - := match p with eq_refl => eq_refl end. - -Goal forall sz : nat, - let sz' := sz in - forall pf : sz = sz', - let feq_refl := exist (fun x : nat => sz = x) sz' eq_refl in - let fpf := exist (fun x : nat => sz = x) sz' pf in feq_refl = fpf -> -proj2_sig feq_refl = proj2_sig fpf. -Proof. - intros. - etransitivity; [ | exact (proj2_sig_path H) ]. - Fail clearbody fpf. diff --git a/test-suite/bugs/closed/5322.v b/test-suite/bugs/closed/5322.v deleted file mode 100644 index 01aec8f29b..0000000000 --- a/test-suite/bugs/closed/5322.v +++ /dev/null @@ -1,14 +0,0 @@ -(* Regression in computing types of branches in "match" *) -Inductive flat_type := Unit | Prod (A B : flat_type). -Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type --> Type := -| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR. -Inductive op : flat_type -> flat_type -> Type := a : op Unit Unit. -Arguments Op {_ _ _ _} _ _. -Definition bound_op {var} - {src2 dst2} - (opc2 : op src2 dst2) - : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2. - refine match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with - | _ => _ - end. diff --git a/test-suite/bugs/closed/5323.v b/test-suite/bugs/closed/5323.v deleted file mode 100644 index 295b7cd9f5..0000000000 --- a/test-suite/bugs/closed/5323.v +++ /dev/null @@ -1,26 +0,0 @@ -(* Revealed a missing re-consideration of postponed problems *) - -Module A. -Inductive flat_type := Unit | Prod (A B : flat_type). -Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type --> Type := -| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR. -Inductive op : flat_type -> flat_type -> Type := . -Arguments Op {_ _ _ _} _ _. -Definition bound_op {var} - {src2 dst2} - (opc2 : op src2 dst2) - : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2 - := match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with end. -End A. - -(* A shorter variant *) -Module B. -Inductive exprf (op : unit -> Type) : Type := -| A : exprf op -| Op tR (opc : op tR) (args : exprf op) : exprf op. -Inductive op : unit -> Type := . -Definition bound_op (dst2 : unit) (opc2 : op dst2) - : forall (args2 : exprf op), Op op dst2 opc2 args2 = A op - := match opc2 in op h return (forall args2 : exprf ?[U], Op ?[V] ?[I] opc2 args2 = A op) with end. -End B. diff --git a/test-suite/bugs/closed/5331.v b/test-suite/bugs/closed/5331.v deleted file mode 100644 index 28743736d3..0000000000 --- a/test-suite/bugs/closed/5331.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Checking no anomaly on some unexpected intropattern *) - -Ltac ih H := induction H as H. -Ltac ih' H H' := induction H as H'. - -Goal True -> True. -Fail intro H; ih H. -intro H; ih' H ipattern:([]). -exact I. -Qed. - diff --git a/test-suite/bugs/closed/5345.v b/test-suite/bugs/closed/5345.v deleted file mode 100644 index d8448f35db..0000000000 --- a/test-suite/bugs/closed/5345.v +++ /dev/null @@ -1,7 +0,0 @@ -Ltac break_tuple := - match goal with - | [ H: context[match ?a with | pair n m => _ end] |- _ ] => - let n := fresh n in - let m := fresh m in - destruct a as [n m] - end. diff --git a/test-suite/bugs/closed/5346.v b/test-suite/bugs/closed/5346.v deleted file mode 100644 index 0118c18704..0000000000 --- a/test-suite/bugs/closed/5346.v +++ /dev/null @@ -1,29 +0,0 @@ -Inductive comp : Type -> Type := -| Ret {T} : forall (v:T), comp T -| Bind {T T'} : forall (p: comp T') (p': T' -> comp T), comp T. - -Notation "'do' x .. y <- p1 ; p2" := - (Bind p1 (fun x => .. (fun y => p2) ..)) - (at level 60, right associativity, - x binder, y binder). - -Definition Fst1 A B (p: comp (A*B)) : comp A := - do '(a, b) <- p; - Ret a. - -Definition Fst2 A B (p: comp (A*B)) : comp A := - match tt with - | _ => Bind p (fun '(a, b) => Ret a) - end. - -Definition Fst3 A B (p: comp (A*B)) : comp A := - match tt with - | _ => do a <- p; - Ret (fst a) - end. - -Definition Fst A B (p: comp (A * B)) : comp A := - match tt with - | _ => do '(a, b) <- p; - Ret a - end. diff --git a/test-suite/bugs/closed/5347.v b/test-suite/bugs/closed/5347.v deleted file mode 100644 index 9267b3eb69..0000000000 --- a/test-suite/bugs/closed/5347.v +++ /dev/null @@ -1,10 +0,0 @@ -Set Universe Polymorphism. - -Axiom X : Type. -(* Used to declare [x0@{u1 u2} : X@{u1}] and [x1@{} : X@{u2}] leaving - the type of x1 with undeclared universes. After PR #891 this should - error at declaration time. *) -Axiom x₀ x₁ : X. -Axiom Xᵢ : X -> Type. - -Check Xᵢ x₁. (* conversion test raised anomaly universe undefined *) diff --git a/test-suite/bugs/closed/5359.v b/test-suite/bugs/closed/5359.v deleted file mode 100644 index 87e69565e3..0000000000 --- a/test-suite/bugs/closed/5359.v +++ /dev/null @@ -1,218 +0,0 @@ -Require Import Coq.nsatz.Nsatz. -Goal False. - - (* the first (succeeding) goal was reached by clearing one hypothesis in the second goal which overflows 6GB of stack space *) - let sugar := constr:( 0%Z ) in - let nparams := constr:( (-1)%Z ) in - let reified_goal := constr:( - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) ) in - let power := constr:( N.one ) in - let reified_givens := constr:( - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEX Z 9)) (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) (Ring_polynom.PEX Z 8))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) - (Ring_polynom.PEX Z 8)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3)))) :: nil)%list ) in - Nsatz.nsatz_compute - (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). - - let sugar := constr:( 0%Z ) in - let nparams := constr:( (-1)%Z ) in - let reified_goal := constr:( - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) ) in - let power := constr:( N.one ) in - let reified_givens := constr:( - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - :: Ring_polynom.PEadd - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6)))) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 6)) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 5)))) (Ring_polynom.PEX Z 7)) - (Ring_polynom.PEsub - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) (Ring_polynom.PEX Z 6)) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)))) - (Ring_polynom.PEX Z 8)) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) (Ring_polynom.PEX Z 9)) - (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) - (Ring_polynom.PEX Z 8))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) - (Ring_polynom.PEX Z 8)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3)))) :: nil)%list ) in - Nsatz.nsatz_compute - (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). diff --git a/test-suite/bugs/closed/5365.v b/test-suite/bugs/closed/5365.v deleted file mode 100644 index be360d24d2..0000000000 --- a/test-suite/bugs/closed/5365.v +++ /dev/null @@ -1,13 +0,0 @@ - -Inductive TupleT : nat -> Type := -| nilT : TupleT 0 -| consT {n} A : (A -> TupleT n) -> TupleT (S n). - -Inductive Tuple : forall n, TupleT n -> Type := - nil : Tuple _ nilT -| cons {n A} (x : A) (F : A -> TupleT n) : Tuple _ (F x) -> Tuple _ (consT A F). - -Inductive TupleMap : forall n, TupleT n -> TupleT n -> Type := - tmNil : TupleMap _ nilT nilT -| tmCons {n} {A B : Type} (F : A -> TupleT n) (G : B -> TupleT n) - : (forall x, sigT (fun y => TupleMap _ (F x) (G y))) -> TupleMap _ (consT A F) (consT B G). diff --git a/test-suite/bugs/closed/5368.v b/test-suite/bugs/closed/5368.v deleted file mode 100644 index 410fe1707d..0000000000 --- a/test-suite/bugs/closed/5368.v +++ /dev/null @@ -1,6 +0,0 @@ -Set Universe Polymorphism. - -Record cantype := {T:Type; op:T -> unit}. -Canonical Structure test (P:Type) := {| T := P -> Type; op := fun _ => tt|}. - -Check (op _ ((fun (_:unit) => Set):_)). diff --git a/test-suite/bugs/closed/5372.v b/test-suite/bugs/closed/5372.v deleted file mode 100644 index e60244cd1d..0000000000 --- a/test-suite/bugs/closed/5372.v +++ /dev/null @@ -1,8 +0,0 @@ -(* coq bug 5372: https://coq.inria.fr/bugs/show_bug.cgi?id=5372 *) -Require Import FunInd. -Function odd (n:nat) := - match n with - | 0 => false - | S n => true - end -with even (n:nat) := false. diff --git a/test-suite/bugs/closed/5377.v b/test-suite/bugs/closed/5377.v deleted file mode 100644 index 130d9f9abf..0000000000 --- a/test-suite/bugs/closed/5377.v +++ /dev/null @@ -1,54 +0,0 @@ -Goal ((forall (t : Type) (x y : t), - True -> - x = y)) -> False. -Proof. - intro HG. - let P := lazymatch goal with - | [ H : forall t x y, True -> @?P t x y - |- _ ] - => P - end in - pose (f := P). - unify f (fun (t : Type) (x y : t) => x = y). -Abort. - -Goal True. -Proof. -let c := lazymatch constr:(fun (T : nat -> Type) (y : nat) (_ : T y) => y) with - | fun _ y _ => @?C y => C - end in -pose (f := c). -unify f (fun n : nat => n). -Abort. - -Goal (forall x : nat, x = x -> x = x \/ x = x) -> True. -Proof. -intro. -let P := lazymatch goal with -| [ H : forall y, @?P y -> @?P y \/ _ |- _ ] - => P -end in -pose (f := P). -unify f (fun x : nat => x = x). -Abort. - -Goal (forall x : nat, x = x -> x = x \/ x = x) -> True. -Proof. -intro. -lazymatch goal with -| [ H : forall y, @?P y -> @?Q y \/ _ |- _ ] - => idtac -end. -Abort. - -Axiom eq : forall {T} (_ : T), Prop. - -Goal forall _ : (forall t (_ : eq t) (x : t), eq x), Prop. -Proof. -intro. -let P := lazymatch goal with -| [ H : forall t _ x, @?P t x |- _ ] - => P -end in -pose (f := P). -Abort. diff --git a/test-suite/bugs/closed/5401.v b/test-suite/bugs/closed/5401.v deleted file mode 100644 index 95193b993b..0000000000 --- a/test-suite/bugs/closed/5401.v +++ /dev/null @@ -1,21 +0,0 @@ -(* Testing printing of bound unnamed variables in pattern printer *) - -Module A. -Parameter P : nat -> Type. -Parameter v : forall m, P m. -Parameter f : forall (P : nat -> Type), (forall a, P a) -> P 0. -Class U (R : P 0) (m : forall x, P x) : Prop. -Instance w : U (f _ (fun _ => v _)) v. -Print HintDb typeclass_instances. -End A. - -(* #5731 *) - -Module B. -Axiom rel : Type -> Prop. -Axiom arrow_rel : forall {A1}, A1 -> rel A1. -Axiom forall_rel : forall E, (forall v1 : Type, E v1 -> rel v1) -> Prop. -Axiom inl_rel: forall_rel _ (fun _ => arrow_rel). -Hint Resolve inl_rel : foo. -Print HintDb foo. -End B. diff --git a/test-suite/bugs/closed/5414.v b/test-suite/bugs/closed/5414.v deleted file mode 100644 index 2522a274fb..0000000000 --- a/test-suite/bugs/closed/5414.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Use of idents bound to ltac names in a "match" *) - -Definition foo : Type. -Proof. - let x := fresh "a" in - refine (forall k : nat * nat, let '(x, _) := k in (_ : Type)). - exact (a = a). -Defined. -Goal foo. -intros k. elim k. (* elim because elim keeps names *) -intros. -Check a. (* We check that the name is "a" *) diff --git a/test-suite/bugs/closed/5434.v b/test-suite/bugs/closed/5434.v deleted file mode 100644 index 5d2460face..0000000000 --- a/test-suite/bugs/closed/5434.v +++ /dev/null @@ -1,18 +0,0 @@ -(* About binders which remain unnamed after typing *) - -Global Set Asymmetric Patterns. - -Definition proj2_sig_map {A} {P Q : A -> Prop} (f : forall a, P a -> Q a) (x : -@sig A P) : @sig A Q - := let 'exist a p := x in exist Q a (f a p). -Axioms (feBW' : Type) (g : Prop -> Prop) (f' : feBW' -> Prop). -Definition foo := @proj2_sig_map feBW' (fun H => True = f' _) (fun H => - g True = g (f' H)) - (fun (a : feBW') (p : (fun H : feBW' => True = - f' H) a) => @f_equal Prop Prop g True (f' a) p). -Print foo. -Goal True. - lazymatch type of foo with - | sig (fun a : ?A => ?P) -> _ - => pose (fun a : A => a = a /\ P = P) - end. diff --git a/test-suite/bugs/closed/5435.v b/test-suite/bugs/closed/5435.v deleted file mode 100644 index 60ace5ce96..0000000000 --- a/test-suite/bugs/closed/5435.v +++ /dev/null @@ -1,2 +0,0 @@ -Definition foo (x : nat) := Eval native_compute in x. - diff --git a/test-suite/bugs/closed/5449.v b/test-suite/bugs/closed/5449.v deleted file mode 100644 index d7fc2aaa00..0000000000 --- a/test-suite/bugs/closed/5449.v +++ /dev/null @@ -1,6 +0,0 @@ -(* An example of decide equality which was failing due to a lhs dep into the rhs *) - -Require Import Coq.PArith.BinPos. -Goal forall x y, {Pos.compare_cont Gt x y = Gt} + {Pos.compare_cont Gt x y <> Gt}. -intros. -decide equality. diff --git a/test-suite/bugs/closed/5460.v b/test-suite/bugs/closed/5460.v deleted file mode 100644 index 50221cdd83..0000000000 --- a/test-suite/bugs/closed/5460.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Bugs in computing dependencies in pattern-matching compilation *) - -Inductive A := a1 | a2. -Inductive B := b. -Inductive C : A -> Type := c : C a1 | d : C a2. -Definition P (x : A) (y : C x) (z : B) : nat := - match z, x, y with - | b, a1, c => 0 - | b, a2, d => 0 - | _, _, _ => 1 - end. diff --git a/test-suite/bugs/closed/5470.v b/test-suite/bugs/closed/5470.v deleted file mode 100644 index 5b3984b6df..0000000000 --- a/test-suite/bugs/closed/5470.v +++ /dev/null @@ -1,3 +0,0 @@ -(* This used to raise an anomaly *) - -Fail Reserved Notation "x +++ y" (at level 70, x binder). diff --git a/test-suite/bugs/closed/5476.v b/test-suite/bugs/closed/5476.v deleted file mode 100644 index b2d9d943bc..0000000000 --- a/test-suite/bugs/closed/5476.v +++ /dev/null @@ -1,28 +0,0 @@ -Require Setoid. - -Goal forall (P : Prop) (T : Type) (m m' : T) (T0 T1 : Type) (P2 : forall _ : -Prop, Prop) - (P0 : Set) (x0 : P0) (P1 : forall (_ : P0) (_ : T), Prop) - (P3 : forall (_ : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (_ : -T) (_ : Prop), Prop) - (o : forall _ : P0, option T1) - (_ : P3 - (fun (k : P0) (_ : T0) (_ : Prop) => - match o k return Prop with - | Some _ => True - | None => False - end) m' P) (_ : P2 (P1 x0 m)) - (_ : forall (f : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (m1 m2 -: T) - (k : P0) (e : T0) (_ : P2 (P1 k m1)), iff (P3 f m2 P) -(f k e (P3 f m1 P))), False. -Proof. - intros ???????????? H0 H H1. - rewrite H1 in H0; eauto with nocore. - { lazymatch goal with - | H : match ?X with _ => _ end |- _ - => first [ lazymatch goal with - | [ H' : context[X] |- _ ] => idtac H - end - | fail 1 "could not find" X ] - end. diff --git a/test-suite/bugs/closed/5486.v b/test-suite/bugs/closed/5486.v deleted file mode 100644 index 390133162f..0000000000 --- a/test-suite/bugs/closed/5486.v +++ /dev/null @@ -1,15 +0,0 @@ -Axiom proof_admitted : False. -Tactic Notation "admit" := abstract case proof_admitted. -Goal forall (T : Type) (p : prod (prod T T) bool) (Fm : Set) (f : Fm) (k : - forall _ : T, Fm), - @eq Fm - (k - match p return T with - | pair p0 swap => fst p0 - end) f. - intros. - (* next statement failed in Bug 5486 *) - match goal with - | [ |- ?f (let (a, b) := ?d in @?e a b) = ?rhs ] - => pose (let (a, b) := d in e a b) as t0 - end. diff --git a/test-suite/bugs/closed/5487.v b/test-suite/bugs/closed/5487.v deleted file mode 100644 index 9b995f4503..0000000000 --- a/test-suite/bugs/closed/5487.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Was a collision between an ltac pattern variable and an evar *) - -Goal forall n, exists m, n = m :> nat. -Proof. - eexists. - Fail match goal with - | [ |- ?x = ?y ] - => match x with y => idtac end - end. diff --git a/test-suite/bugs/closed/5500.v b/test-suite/bugs/closed/5500.v deleted file mode 100644 index aa63e2ab0e..0000000000 --- a/test-suite/bugs/closed/5500.v +++ /dev/null @@ -1,35 +0,0 @@ -(* Too weak check on the correctness of return clause was leading to an anomaly *) - -Inductive Vector A: nat -> Type := - nil: Vector A O -| cons: forall n, A -> Vector A n -> Vector A (S n). - -(* This could be made working with a better inference of inner return - predicates from the return predicate at the higher level of the - nested matching. Currently, we only check that it does not raise an - anomaly, but eventually, the "Fail" could be removed. *) - -Fail Definition hd_fst A x n (v: A * Vector A (S n)) := - match v as v0 return match v0 with - (l, r) => - match r in Vector _ n return match n with 0 => Type | S _ => Type end with - nil _ => A - | cons _ _ _ _ => A - end - end with - (_, nil _) => x - | (_, cons _ n hd tl) => hd - end. - -(* This is another example of failure but involving beta-reduction and - not iota-reduction. Thus, for this one, I don't see how it could be - solved by small inversion, whatever smart is small inversion. *) - -Inductive A : (Type->Type) -> Type := J : A (fun x => x). - -Fail Check fun x : nat * A (fun x => x) => - match x return match x with - (y,z) => match z in A f return f Type with J => bool end - end with - (y,J) => true - end. diff --git a/test-suite/bugs/closed/5501.v b/test-suite/bugs/closed/5501.v deleted file mode 100644 index 24739a3658..0000000000 --- a/test-suite/bugs/closed/5501.v +++ /dev/null @@ -1,21 +0,0 @@ -Set Universe Polymorphism. - -Record Pred@{A} := - { car :> Type@{A} - ; P : car -> Prop - }. - -Class All@{A} (A : Pred@{A}) : Type := - { proof : forall (a : A), P A a - }. - -Record Pred_All@{A} : Type := - { P' :> Pred@{A} - ; P'_All : All P' - }. - -Global Instance Pred_All_instance (A : Pred_All) : All A := P'_All A. - -Definition Pred_All_proof {A : Pred_All} (a : A) : P A a. -Proof. -solve[auto using proof]. diff --git a/test-suite/bugs/closed/5522.v b/test-suite/bugs/closed/5522.v deleted file mode 100644 index 0fae9ede42..0000000000 --- a/test-suite/bugs/closed/5522.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Checking support for scope delimiters and as clauses in 'pat - applied to notations with binders *) - -Notation "'multifun' x .. y 'in' f" := (fun x => .. (fun y => f) .. ) - (at level 200, x binder, y binder, f at level 200). - -Check multifun '((x, y)%core as z) in (x+y,0)=z. diff --git a/test-suite/bugs/closed/5523.v b/test-suite/bugs/closed/5523.v deleted file mode 100644 index d7582a3797..0000000000 --- a/test-suite/bugs/closed/5523.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Support for complex constructions in recursive notations, especially "match". *) - -Definition Let_In {A P} (x : A) (f : forall a : A, P a) : P x := let y := x in f y. -Notation "'dlet' x , y := v 'in' ( a , b , .. , c )" - := (Let_In v (fun '(x, y) => pair .. (pair a b) .. c)) - (at level 0). diff --git a/test-suite/bugs/closed/5526.v b/test-suite/bugs/closed/5526.v deleted file mode 100644 index 88f219be30..0000000000 --- a/test-suite/bugs/closed/5526.v +++ /dev/null @@ -1,3 +0,0 @@ -Fail Notation "x === x" := (eq_refl x) (at level 10). -Reserved Notation "x === x" (only printing, at level 10). -Notation "x === x" := (eq_refl x) (only printing). diff --git a/test-suite/bugs/closed/5532.v b/test-suite/bugs/closed/5532.v deleted file mode 100644 index ee5446e548..0000000000 --- a/test-suite/bugs/closed/5532.v +++ /dev/null @@ -1,15 +0,0 @@ -(* A wish granted by the new support for patterns in notations *) - -Local Notation mkmatch0 e p - := match e with - | p => true - | _ => false - end. -Local Notation "'mkmatch' [[ e ]] [[ p ]]" - := match e with - | p => true - | _ => false - end - (at level 0, p pattern). -Check mkmatch0 _ ((0, 0)%core). -Check mkmatch [[ _ ]] [[ ((0, 0)%core) ]]. diff --git a/test-suite/bugs/closed/5539.v b/test-suite/bugs/closed/5539.v deleted file mode 100644 index 48e5568e9b..0000000000 --- a/test-suite/bugs/closed/5539.v +++ /dev/null @@ -1,15 +0,0 @@ -Set Universe Polymorphism. - -Inductive D : nat -> Type := -| DO : D O -| DS n : D n -> D (S n). - -Fixpoint follow (n : nat) : D n -> Prop := - match n with - | O => fun d => let 'DO := d in True - | S n' => fun d => (let 'DS _ d' := d in fun f => f d') (follow n') - end. - -Definition step (n : nat) (d : D n) (H : follow n d) : - follow (S n) (DS n d) - := H. diff --git a/test-suite/bugs/closed/5547.v b/test-suite/bugs/closed/5547.v deleted file mode 100644 index 79633f4893..0000000000 --- a/test-suite/bugs/closed/5547.v +++ /dev/null @@ -1,16 +0,0 @@ -(* Checking typability of intermediate return predicates in nested pattern-matching *) - -Inductive A : (Type->Type) -> Type := J : A (fun x => x). -Definition ret (x : nat * A (fun x => x)) - := match x return Type with - | (y,z) => match z in A f return f Type with - | J => bool - end - end. -Definition foo : forall x, ret x. -Proof. -Fail refine (fun x - => match x return ret x with - | (y,J) => true - end - ). diff --git a/test-suite/bugs/closed/5550.v b/test-suite/bugs/closed/5550.v deleted file mode 100644 index bb1222489a..0000000000 --- a/test-suite/bugs/closed/5550.v +++ /dev/null @@ -1,10 +0,0 @@ -Section foo. - - Variable bar : Prop. - Variable H : bar. - - Goal bar. - typeclasses eauto with foobar. - Qed. - -End foo. diff --git a/test-suite/bugs/closed/5578.v b/test-suite/bugs/closed/5578.v deleted file mode 100644 index b9f0bc45c6..0000000000 --- a/test-suite/bugs/closed/5578.v +++ /dev/null @@ -1,57 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 1549 lines to 298 lines, then from 277 lines to 133 lines, then from 985 lines to 138 lines, then from 206 lines to 139 lines, then from 203 lines to 142 lines, then from 262 lines to 152 lines, then from 567 lines to 151 lines, then from 3746 lines to 151 lines, then from 577 lines to 151 lines, then from 187 lines to 151 lines, thenfrom 981 lines to 940 lines, then from 938 lines to 175 lines, then from 589 lines to 205 lines, then from 3797 lines to 205 lines, then from 628 lines to 206 lines, then from 238 lines to 205 lines, then from 1346 lines to 213 lines, then from 633 lines to 214 lines, then from 243 lines to 213 lines, then from 5656 lines to 245 lines, then from 661 lines to 272 lines, then from 3856 lines to 352 lines, then from 1266 lines to 407 lines, then from 421 lines to 406 lines, then from 424 lines to 91 lines, then from 105 lines to 91 lines, then from 85 lines to 55 lines, then from 69 lines to 55 lines *) -(* coqc version trunk (May 2017) compiled on May 30 2017 13:28:59 with OCaml -4.02.3 - coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-trunk,trunk (fd36c0451c26e44b1b7e93299d3367ad2d35fee3) *) - -Class Proper {A} (R : A -> A -> Prop) (m : A) := mkp : R m m. -Definition respectful {A B} (R : A -> A -> Prop) (R' : B -> B -> Prop) (f g : A -> B) := forall x y, R x y -> R' (f x) (g y). -Set Implicit Arguments. - -Class EqDec (A : Set) := { - eqb : A -> A -> bool ; - eqb_leibniz : forall x y, eqb x y = true <-> x = y -}. - -Infix "?=" := eqb (at level 70) : eq_scope. - -Inductive Comp : Set -> Type := -| Bind : forall (A B : Set), Comp B -> (B -> Comp A) -> Comp A. - -Open Scope eq_scope. - -Goal forall (Rat : Set) (PositiveMap_t : Set -> Set) - type (t : type) (interp_type_list_message interp_type_rand interp_type_message : nat -> Set), - (forall eta : nat, PositiveMap_t (interp_type_rand eta) -> interp_type_list_message eta -> interp_type_message eta) -> - ((nat -> Rat) -> Prop) -> - forall (interp_type_sbool : nat -> Set) (interp_type0 : type -> nat -> Set), - (forall eta : nat, - (interp_type_list_message eta -> interp_type_message eta) -> PositiveMap_t (interp_type_rand eta) -> interp_type0 t eta) - -> (forall (t0 : type) (eta : nat), EqDec (interp_type0 t0 eta)) - -> (bool -> Comp bool) -> False. - clear. - intros Rat PositiveMap_t type t interp_type_list_message interp_type_rand interp_type_message adv negligible interp_type_sbool - interp_type interp_term_fixed_t_x - EqDec_interp_type ret_bool. - assert (forall f adv' k - (lem : forall (eta : nat) (evil_rands rands : PositiveMap_t -(interp_type_rand eta)), - (interp_term_fixed_t_x eta (adv eta evil_rands) rands - ?= interp_term_fixed_t_x eta (adv eta evil_rands) rands) = true), - (forall (eta : nat), Proper (respectful eq eq) (f eta)) - -> negligible - (fun eta : nat => - f eta ( - (Bind (k eta) (fun rands => - ret_bool (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands)))))). - Undo. - assert (forall f adv' k - (lem : forall (eta : nat) (rands : PositiveMap_t -(interp_type_rand eta)), - (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands) = true), - (forall (eta : nat), Proper (respectful eq eq) (f eta)) - -> negligible - (fun eta : nat => - f eta ( - (Bind (k eta) (fun rands => - ret_bool (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands)))))). - (* Error: Anomaly "Signature and its instance do not match." Please report at http://coq.inria.fr/bugs/. *) diff --git a/test-suite/bugs/closed/5598.v b/test-suite/bugs/closed/5598.v deleted file mode 100644 index 55fef1a575..0000000000 --- a/test-suite/bugs/closed/5598.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Checking when discharge of an existing class is possible *) -Section foo. - Context {T} (a : T) (b : T). - Let k := eq_refl a. - Existing Class eq. - Fail Global Existing Instance k. - Existing Instance k. -End foo. diff --git a/test-suite/bugs/closed/5608.v b/test-suite/bugs/closed/5608.v deleted file mode 100644 index f02eae69c2..0000000000 --- a/test-suite/bugs/closed/5608.v +++ /dev/null @@ -1,33 +0,0 @@ -Reserved Notation "'slet' x .. y := A 'in' b" - (at level 200, x binder, y binder, b at level 200, format "'slet' x .. y := A 'in' '//' b"). -Reserved Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" - (at level 200, format "T x [1] = { A } ; '//' 'return' ( b0 , b1 , .. , b2 )"). - -Delimit Scope ctype_scope with ctype. -Local Open Scope ctype_scope. -Delimit Scope expr_scope with expr. -Inductive base_type := TZ | TWord (logsz : nat). -Inductive flat_type := Tbase (T : base_type) | Prod (A B : flat_type). -Context {var : base_type -> Type}. -Fixpoint interp_flat_type (interp_base_type : base_type -> Type) (t : -flat_type) := - match t with - | Tbase t => interp_base_type t - | Prod x y => prod (interp_flat_type interp_base_type x) (interp_flat_type -interp_base_type y) - end. -Inductive exprf : flat_type -> Type := -| Var {t} (v : var t) : exprf (Tbase t) -| LetIn {tx} (ex : exprf tx) {tC} (eC : interp_flat_type var tx -> exprf tC) : -exprf tC -| Pair {tx} (ex : exprf tx) {ty} (ey : exprf ty) : exprf (Prod tx ty). -Global Arguments Var {_} _. -Global Arguments LetIn {_} _ {_} _. -Global Arguments Pair {_} _ {_} _. -Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" := (LetIn (tx:=T) A -(fun x => Pair .. (Pair b0%expr b1%expr) .. b2%expr)) : expr_scope. -Definition foo := - (fun x3 => - (LetIn (Var x3) (fun x18 : var TZ - => (Pair (Var x18) (Var x18))))). -Print foo. diff --git a/test-suite/bugs/closed/5618.v b/test-suite/bugs/closed/5618.v deleted file mode 100644 index 47e0e92d2a..0000000000 --- a/test-suite/bugs/closed/5618.v +++ /dev/null @@ -1,9 +0,0 @@ -Require Import FunInd. - -Function test {T} (v : T) (x : nat) : nat := - match x with - | 0 => 0 - | S x' => test v x' - end. - -Check R_test_complete. diff --git a/test-suite/bugs/closed/5641.v b/test-suite/bugs/closed/5641.v deleted file mode 100644 index 9f3246f33d..0000000000 --- a/test-suite/bugs/closed/5641.v +++ /dev/null @@ -1,6 +0,0 @@ -Set Universe Polymorphism. - -Definition foo@{i j} (A : Type@{i}) : Type@{j}. -Proof. -abstract (exact ltac:(abstract (exact A))). -Defined. diff --git a/test-suite/bugs/closed/5666.v b/test-suite/bugs/closed/5666.v deleted file mode 100644 index d55a6e57b4..0000000000 --- a/test-suite/bugs/closed/5666.v +++ /dev/null @@ -1,4 +0,0 @@ -Inductive foo := Foo : False -> foo. -Goal foo. -try (constructor ; fail 0). -Fail try (constructor ; fail 1). diff --git a/test-suite/bugs/closed/5671.v b/test-suite/bugs/closed/5671.v deleted file mode 100644 index c9a085045a..0000000000 --- a/test-suite/bugs/closed/5671.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Fixing Meta-unclean specialize *) - -Require Import Setoid. -Axiom a : forall x, x=0 -> True. -Lemma lem (x y1 y2:nat) (H:x=0) (H0:eq y1 y2) : y1 = y2. -specialize a with (1:=H). clear H x. intros _. -setoid_rewrite H0. diff --git a/test-suite/bugs/closed/5683.v b/test-suite/bugs/closed/5683.v deleted file mode 100644 index b5c6a48ec0..0000000000 --- a/test-suite/bugs/closed/5683.v +++ /dev/null @@ -1,71 +0,0 @@ -Require Import Program.Tactics. -Require Import FunctionalExtensionality. - -Inductive Succ A := -| Succ_O : Succ A -| Succ_S : A -> Succ A. -Arguments Succ_O {A}. -Arguments Succ_S {A} _. - -Inductive Zero : Type :=. - -Inductive ty := -| ty_nat : ty -| ty_arr : ty -> ty -> ty. - -Inductive term A := -| term_abs : ty -> term (Succ A) -> term A -| term_app : term A -> term A -> term A -| term_var : A -> term A -| term_nat : nat -> term A. -Arguments term_abs {A} _ _. -Arguments term_app {A} _ _. -Arguments term_var {A} _. -Arguments term_nat {A} _. - -Class Functor F := -{ - ret : forall {A}, A -> F A; - fmap : forall {A B}, (A -> B) -> F A -> F B; - fmap_id : forall {A} (fa : F A), fmap (@id A) fa = fa; - fmap_compose : forall {A B C} (fa : F A) (g : B -> C) (h : A -> B), fmap (fun -a => g (h a)) fa = fmap g (fmap h fa) -}. - -Class Monad M `{Functor M} := -{ - bind : forall {A B}, M A -> (A -> M B) -> M B; - ret_left_id : forall {A B} (a : A) (f : A -> M B), bind (ret a) f = f a; - ret_right_id : forall {A} (m : M A), bind m ret = m; - bind_assoc : forall {A B C} (m : M A) (f : A -> M B) (g : B -> M C), bind -(bind m f) g = bind m (fun x => bind (f x) g) -}. - -Instance Succ_Functor : Functor Succ. -Proof. - unshelve econstructor. - - intros A B f fa. - destruct fa. - + apply Succ_O. - + apply Succ_S. tauto. - - intros. apply Succ_S. assumption. - - intros A [|a]; reflexivity. - - intros A B C [|a] g h; reflexivity. -Defined. - -(* Anomaly: Not an arity *) -Program Fixpoint term_bind {A B} (tm : term A) (f : A -> term B) : term B := - let Succ_f (var : Succ A) := - match var with - | Succ_O => term_var Succ_O - | Succ_S var' => _ - end in - match tm with - | term_app tm1 tm2 => term_app (term_bind tm1 f) (term_bind tm2 f) - | term_abs ty body => term_abs ty (term_bind body Succ_f) - | term_var a => f a - | term_nat n => term_nat n - end. -Next Obligation. - intros. -Admitted. diff --git a/test-suite/bugs/closed/5692.v b/test-suite/bugs/closed/5692.v deleted file mode 100644 index 4c8d464f19..0000000000 --- a/test-suite/bugs/closed/5692.v +++ /dev/null @@ -1,88 +0,0 @@ -Set Primitive Projections. -Require Import ZArith ssreflect. - -Module Test1. - -Structure semigroup := SemiGroup { - sg_car :> Type; - sg_op : sg_car -> sg_car -> sg_car; -}. - -Structure monoid := Monoid { - monoid_car :> Type; - monoid_op : monoid_car -> monoid_car -> monoid_car; - monoid_unit : monoid_car; -}. - -Coercion monoid_sg (X : monoid) : semigroup := - SemiGroup (monoid_car X) (monoid_op X). -Canonical Structure monoid_sg. - -Parameter X : monoid. -Parameter x y : X. - -Check (sg_op _ x y). - -End Test1. - -Module Test2. - -Structure semigroup := SemiGroup { - sg_car :> Type; - sg_op : sg_car -> sg_car -> sg_car; -}. - -Structure monoid := Monoid { - monoid_car :> Type; - monoid_op : monoid_car -> monoid_car -> monoid_car; - monoid_unit : monoid_car; - monoid_left_id x : monoid_op monoid_unit x = x; -}. - -Coercion monoid_sg (X : monoid) : semigroup := - SemiGroup (monoid_car X) (monoid_op X). -Canonical Structure monoid_sg. - -Canonical Structure nat_sg := SemiGroup nat plus. -Canonical Structure nat_monoid := Monoid nat plus 0 plus_O_n. - -Lemma foo (x : nat) : 0 + x = x. -Proof. -apply monoid_left_id. -Qed. - -End Test2. - -Module Test3. - -Structure semigroup := SemiGroup { - sg_car :> Type; - sg_op : sg_car -> sg_car -> sg_car; -}. - -Structure group := Something { - group_car :> Type; - group_op : group_car -> group_car -> group_car; - group_neg : group_car -> group_car; - group_neg_op' x y : group_neg (group_op x y) = group_op (group_neg x) (group_neg y) -}. - -Coercion group_sg (X : group) : semigroup := - SemiGroup (group_car X) (group_op X). -Canonical Structure group_sg. - -Axiom group_neg_op : forall (X : group) (x y : X), - group_neg X (sg_op (group_sg X) x y) = sg_op (group_sg X) (group_neg X x) (group_neg X y). - -Canonical Structure Z_sg := SemiGroup Z Z.add . -Canonical Structure Z_group := Something Z Z.add Z.opp Z.opp_add_distr. - -Lemma foo (x y : Z) : - sg_op Z_sg (group_neg Z_group x) (group_neg Z_group y) = - group_neg Z_group (sg_op Z_sg x y). -Proof. - rewrite -group_neg_op. - reflexivity. -Qed. - -End Test3. diff --git a/test-suite/bugs/closed/5696.v b/test-suite/bugs/closed/5696.v deleted file mode 100644 index a20ad1b4da..0000000000 --- a/test-suite/bugs/closed/5696.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Slightly improving interpretation of Ltac subterms in notations *) - -Notation "'var2' x .. y = z ; e" := (ltac:(exact z), (fun x => .. (fun y => e) -..)) (at level 200, x binder, y binder, e at level 220). -Check (var2 a = 1; a). diff --git a/test-suite/bugs/closed/5697.v b/test-suite/bugs/closed/5697.v deleted file mode 100644 index c653f992af..0000000000 --- a/test-suite/bugs/closed/5697.v +++ /dev/null @@ -1,19 +0,0 @@ -Set Primitive Projections. - -Record foo : Type := Foo { foo_car: nat }. - -Goal forall x y : nat, x <> y -> Foo x <> Foo y. -Proof. -intros. -intros H'. -congruence. -Qed. - -Record bar (A : Type) : Type := Bar { bar_car: A }. - -Goal forall x y : nat, x <> y -> Bar nat x <> Bar nat y. -Proof. -intros. -intros H'. -congruence. -Qed. diff --git a/test-suite/bugs/closed/5707.v b/test-suite/bugs/closed/5707.v deleted file mode 100644 index 785844c66d..0000000000 --- a/test-suite/bugs/closed/5707.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Destruct and primitive projections *) - -(* Checking the (superficial) part of #5707: - "destruct" should be able to use non-dependent case analysis when - dependent case analysis is not available and unneeded *) - -Set Primitive Projections. - -Inductive foo := Foo { proj1 : nat; proj2 : nat }. - -Goal forall x : foo, True. -Proof. intros x. destruct x. diff --git a/test-suite/bugs/closed/5713.v b/test-suite/bugs/closed/5713.v deleted file mode 100644 index 9daf9647fc..0000000000 --- a/test-suite/bugs/closed/5713.v +++ /dev/null @@ -1,15 +0,0 @@ -(* Checking that classical_right/classical_left work in an empty context *) - -Require Import Classical. - -Parameter A:Prop. - -Goal A \/ ~A. -classical_right. -assumption. -Qed. - -Goal ~A \/ A. -classical_left. -assumption. -Qed. diff --git a/test-suite/bugs/closed/5717.v b/test-suite/bugs/closed/5717.v deleted file mode 100644 index 1bfd917d25..0000000000 --- a/test-suite/bugs/closed/5717.v +++ /dev/null @@ -1,5 +0,0 @@ -Definition foo@{i} (A : Type@{i}) (l : list A) := - match l with - | nil => nil - | cons _ t => t - end. diff --git a/test-suite/bugs/closed/5719.v b/test-suite/bugs/closed/5719.v deleted file mode 100644 index 0fad5f54ea..0000000000 --- a/test-suite/bugs/closed/5719.v +++ /dev/null @@ -1,9 +0,0 @@ -Axiom cons_data_one : - forall (Aone : unit -> Set) (i : unit) (a : Aone i), nat. -Axiom P : nat -> Prop. -Axiom children_data_rect3 : forall {Aone : unit -> Set} - (cons_one_case : forall (i : unit) (b : Aone i), - nat -> nat -> P (cons_data_one Aone i b)), - P 0. -Fail Definition decide_children_equality IH := children_data_rect3 - (fun _ '(existT _ _ _) => match IH with tt => _ end). diff --git a/test-suite/bugs/closed/5726.v b/test-suite/bugs/closed/5726.v deleted file mode 100644 index 53ef473572..0000000000 --- a/test-suite/bugs/closed/5726.v +++ /dev/null @@ -1,34 +0,0 @@ -Set Universe Polymorphism. -Set Printing Universes. - -Module GlobalReference. - - Definition type' := Type. - Notation type := type'. - Check type@{Set}. - -End GlobalReference. - -Module TypeLiteral. - - Notation type := Type. - Check type@{Set}. - Check type@{Prop}. - -End TypeLiteral. - -Module ExplicitSort. - Monomorphic Universe u. - Notation foo := Type@{u}. - Fail Check foo@{Set}. - Fail Check foo@{u}. - - Notation bar := Type. - Check bar@{u}. -End ExplicitSort. - -Module PropNotationUnsupported. - Notation foo := Prop. - Fail Check foo@{Set}. - Fail Check foo@{Type}. -End PropNotationUnsupported. diff --git a/test-suite/bugs/closed/5741.v b/test-suite/bugs/closed/5741.v deleted file mode 100644 index f6598f192d..0000000000 --- a/test-suite/bugs/closed/5741.v +++ /dev/null @@ -1,4 +0,0 @@ -(* Check no anomaly in info_trivial *) - -Goal True. -info_trivial. diff --git a/test-suite/bugs/closed/5749.v b/test-suite/bugs/closed/5749.v deleted file mode 100644 index 81bfe351c5..0000000000 --- a/test-suite/bugs/closed/5749.v +++ /dev/null @@ -1,18 +0,0 @@ -(* Checking computation of free vars of a term for generalization *) - -Definition Decision := fun P : Prop => {P} + {~ P}. -Class SetUnfold (P Q : Prop) : Prop := Build_SetUnfold { set_unfold : P <-> Q -}. - -Section Filter_Help. - - Context {A: Type}. - Context (fold_right : forall A B : Type, (B -> A -> A) -> A -> list B -> A). - Definition lType2 := (sigT (fun (P : A -> Prop) => forall a, Decision (P -a))). - Definition test (X: lType2) := let (x, _) := X in x. - - Global Instance foo `{fhl1 : list lType2} m Q: - SetUnfold (Q) - (fold_right _ _ (fun (s : lType2) => let (P, _) := s in and (P -m)) (Q) (fhl1)). diff --git a/test-suite/bugs/closed/5750.v b/test-suite/bugs/closed/5750.v deleted file mode 100644 index 6d0e21f5d0..0000000000 --- a/test-suite/bugs/closed/5750.v +++ /dev/null @@ -1,3 +0,0 @@ -(* Check printability of the hole of the context *) -Goal 0 = 0. -match goal with |- context c [0] => idtac c end. diff --git a/test-suite/bugs/closed/5755.v b/test-suite/bugs/closed/5755.v deleted file mode 100644 index e07fdcf831..0000000000 --- a/test-suite/bugs/closed/5755.v +++ /dev/null @@ -1,16 +0,0 @@ -(* Sections taking care of let-ins for inductive types *) - -Section Foo. - -Inductive foo (A : Type) (x : A) (y := x) (y : A) := Foo. - -End Foo. - -Section Foo2. - -Variable B : Type. -Variable b : B. -Let c := b. -Inductive foo2 (A : Type) (x : A) (y := x) (y : A) := Foo2 : c=c -> foo2 A x y. - -End Foo2. diff --git a/test-suite/bugs/closed/5757.v b/test-suite/bugs/closed/5757.v deleted file mode 100644 index 0d0f2eed44..0000000000 --- a/test-suite/bugs/closed/5757.v +++ /dev/null @@ -1,76 +0,0 @@ -(* Check that resolved status of evars follows "restrict" *) - -Axiom H : forall (v : nat), Some 0 = Some v -> True. -Lemma L : True. -eapply H with _; -match goal with - | |- Some 0 = Some ?v => change (Some (0+0) = Some v) -end. -Abort. - -(* The original example *) - -Set Default Proof Using "Type". - -Module heap_lang. - -Inductive expr := - | InjR (e : expr). - -Inductive val := - | InjRV (v : val). - -Bind Scope val_scope with val. - -Fixpoint of_val (v : val) : expr := - match v with - | InjRV v => InjR (of_val v) - end. - -Fixpoint to_val (e : expr) : option val := None. - -End heap_lang. -Export heap_lang. - -Module W. -Inductive expr := - | Val (v : val) - (* Sums *) - | InjR (e : expr). - -Fixpoint to_expr (e : expr) : heap_lang.expr := - match e with - | Val v => of_val v - | InjR e => heap_lang.InjR (to_expr e) - end. - -End W. - - - -Section Tests. - - Context (iProp: Type). - Context (WPre: expr -> Prop). - - Context (tac_wp_alloc : - forall (e : expr) (v : val), - to_val e = Some v -> WPre e). - - Lemma push_atomic_spec (x: val) : - WPre (InjR (of_val x)). - Proof. -(* This works. *) -eapply tac_wp_alloc with _. -match goal with - | |- to_val ?e = Some ?v => - change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v) -end. -Undo. Undo. -(* This is fixed *) -eapply tac_wp_alloc with _; -match goal with - | |- to_val ?e = Some ?v => - change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v) -end. -Abort. diff --git a/test-suite/bugs/closed/5761.v b/test-suite/bugs/closed/5761.v deleted file mode 100644 index 6f28d1981a..0000000000 --- a/test-suite/bugs/closed/5761.v +++ /dev/null @@ -1,126 +0,0 @@ -Set Primitive Projections. -Record mix := { a : nat ; b : a = a ; c : nat ; d : a = c ; e : nat ; f : nat }. -Ltac strip_args T ctor := - lazymatch type of ctor with - | context[T] - => match eval cbv beta in ctor with - | ?ctor _ => strip_args T ctor - | _ => ctor - end - end. -Ltac get_ctor T := - let full_ctor := constr:(ltac:(let x := fresh in intro x; econstructor; apply -x) : T -> T) in - let ctor := constr:(fun x : T => ltac:(let v := strip_args T (full_ctor x) in -exact v)) in - lazymatch ctor with - | fun _ => ?ctor => ctor - end. -Ltac uncurry_domain f := - lazymatch type of f with - | forall (a : ?A) (b : @ ?B a), _ - => uncurry_domain (fun ab : { a : A & B a } => f (projT1 ab) (projT2 ab)) - | _ => eval cbv beta in f - end. -Ltac get_of_sigma T := - let ctor := get_ctor T in - uncurry_domain ctor. -Ltac repeat_existT := - lazymatch goal with - | [ |- sigT _ ] => simple refine (existT _ _ _); [ repeat_existT | shelve ] - | _ => shelve - end. - Ltac prove_to_of_sigma_goal of_sigma := - let v := fresh "v" in - simple refine (exist _ _ (fun v => _ : id _ (of_sigma v) = v)); - try unfold of_sigma; - [ intro v; destruct v; repeat_existT - | cbv beta; - repeat match goal with - | [ |- context[projT2 ?k] ] - => let x := fresh "x" in - is_var k; - destruct k as [k x]; cbn [projT1 projT2] - end; - unfold id; reflexivity ]. -Ltac prove_to_of_sigma of_sigma := - constr:( - ltac:(prove_to_of_sigma_goal of_sigma) - : { to_sigma : _ | forall v, id to_sigma (of_sigma v) = v }). -Ltac get_to_sigma_gen of_sigma := - let v := prove_to_of_sigma of_sigma in - eval hnf in (proj1_sig v). -Ltac get_to_sigma T := - let of_sigma := get_of_sigma T in - get_to_sigma_gen of_sigma. -Definition to_sigma := ltac:(let v := get_to_sigma mix in exact v). -(* Error: -In nested Ltac calls to "get_to_sigma", "get_to_sigma_gen", -"prove_to_of_sigma", -"(_ : {to_sigma : _ | forall v, id to_sigma (of_sigma v) = v})" (with -of_sigma:=fun - ab : {_ - : {_ - : {ab : {_ : {a : nat & a = a} & nat} & - projT1 (projT1 ab) = projT2 ab} & nat} & nat} => - {| - a := projT1 (projT1 (projT1 (projT1 (projT1 ab)))); - b := projT2 (projT1 (projT1 (projT1 (projT1 ab)))); - c := projT2 (projT1 (projT1 (projT1 ab))); - d := projT2 (projT1 (projT1 ab)); - e := projT2 (projT1 ab); - f := projT2 ab |}) and "prove_to_of_sigma_goal", last call failed. -Anomaly "Uncaught exception Not_found." Please report at -http://coq.inria.fr/bugs/. -frame @ file "toplevel/coqtop.ml", line 640, characters 6-22 -frame @ file "list.ml", line 73, characters 12-15 -frame @ file "toplevel/vernac.ml", line 344, characters 2-13 -frame @ file "toplevel/vernac.ml", line 308, characters 14-75 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "lib/flags.ml", line 141, characters 19-40 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "lib/flags.ml", line 11, characters 15-18 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "toplevel/vernac.ml", line 167, characters 6-16 -frame @ file "toplevel/vernac.ml", line 151, characters 26-39 -frame @ file "stm/stm.ml", line 2365, characters 2-35 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "stm/stm.ml", line 2355, characters 4-48 -frame @ file "stm/stm.ml", line 2321, characters 4-100 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "stm/stm.ml", line 832, characters 6-10 -frame @ file "stm/stm.ml", line 2206, characters 10-32 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "stm/stm.ml", line 975, characters 8-81 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "vernac/vernacentries.ml", line 2216, characters 10-389 -frame @ file "lib/flags.ml", line 141, characters 19-40 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "lib/flags.ml", line 11, characters 15-18 -frame @ file "vernac/command.ml", line 150, characters 4-56 -frame @ file "interp/constrintern.ml", line 2046, characters 2-73 -frame @ file "pretyping/pretyping.ml", line 1194, characters 19-77 -frame @ file "pretyping/pretyping.ml", line 1155, characters 8-72 -frame @ file "pretyping/pretyping.ml", line 628, characters 23-65 -frame @ file "plugins/ltac/tacinterp.ml", line 2095, characters 21-61 -frame @ file "proofs/pfedit.ml", line 178, characters 6-22 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "proofs/pfedit.ml", line 174, characters 8-36 -frame @ file "proofs/proof.ml", line 351, characters 4-30 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "engine/proofview.ml", line 1222, characters 8-12 -frame @ file "plugins/ltac/tacinterp.ml", line 2020, characters 19-36 -frame @ file "plugins/ltac/tacinterp.ml", line 618, characters 4-70 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "plugins/ltac/tacinterp.ml", line 214, characters 6-9 -frame @ file "pretyping/pretyping.ml", line 1198, characters 19-62 -frame @ file "pretyping/pretyping.ml", line 1155, characters 8-72 -raise @ unknown -frame @ file "pretyping/pretyping.ml", line 628, characters 23-65 -frame @ file "plugins/ltac/tacinterp.ml", line 2095, characters 21-61 -frame @ file "proofs/pfedit.ml", line 178, characters 6-22 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 -frame @ file "proofs/pfedit.ml", line 174, characters 8-36 -frame @ file "proofs/proof.ml", line 351, characters 4-30 -raise @ file "lib/exninfo.ml", line 63, characters 8-15 - *) diff --git a/test-suite/bugs/closed/5762.v b/test-suite/bugs/closed/5762.v deleted file mode 100644 index 55d36bd722..0000000000 --- a/test-suite/bugs/closed/5762.v +++ /dev/null @@ -1,34 +0,0 @@ -(* Supporting imp. params. in inductive or fixpoints mutually defined with a notation *) - -Reserved Notation "* a" (at level 70). -Inductive P {n : nat} : nat -> Prop := -| c m : *m -where "* m" := (P m). - -Reserved Notation "##". -Inductive I {A:Type} := C : ## where "##" := I. - -(* The following was working in 8.6 *) - -Require Import Vector. - -Reserved Notation "# a" (at level 70). -Fixpoint f {n : nat} (v:Vector.t nat n) : nat := - match v with - | nil _ => 0 - | cons _ _ _ v => S (#v) - end -where "# v" := (f v). - -(* The following was working in 8.6 *) - -Reserved Notation "%% a" (at level 70). -Record R := - {g : forall {A} (a:A), a=a where "%% x" := (g x); - k : %% 0 = eq_refl}. - -(* An extra example *) - -Module A. -Inductive I {A:Type} := C : # 0 -> I where "# I" := (I = I) : I_scope. -End A. diff --git a/test-suite/bugs/closed/5765.v b/test-suite/bugs/closed/5765.v deleted file mode 100644 index 343ab49357..0000000000 --- a/test-suite/bugs/closed/5765.v +++ /dev/null @@ -1,3 +0,0 @@ -(* 'pat binder not (yet?) allowed in parameters of inductive types *) - -Fail Inductive X '(a,b) := x. diff --git a/test-suite/bugs/closed/5769.v b/test-suite/bugs/closed/5769.v deleted file mode 100644 index 42573aad87..0000000000 --- a/test-suite/bugs/closed/5769.v +++ /dev/null @@ -1,20 +0,0 @@ -(* Check a few naming heuristics based on types *) -(* was buggy for types names _something *) - -Inductive _foo :=. -Lemma bob : (sigT (fun x : nat => _foo)) -> _foo. -destruct 1. -exact _f. -Abort. - -Inductive _'Foo :=. -Lemma bob : (sigT (fun x : nat => _'Foo)) -> _'Foo. -destruct 1. -exact _'f. -Abort. - -Inductive ____ :=. -Lemma bob : (sigT (fun x : nat => ____)) -> ____. -destruct 1. -exact x0. -Abort. diff --git a/test-suite/bugs/closed/5786.v b/test-suite/bugs/closed/5786.v deleted file mode 100644 index 20301ec4f5..0000000000 --- a/test-suite/bugs/closed/5786.v +++ /dev/null @@ -1,29 +0,0 @@ -(* Printing all kinds of Ltac generic arguments *) - -Tactic Notation "myidtac" string(v) := idtac v. -Goal True. -myidtac "foo". -Abort. - -Tactic Notation "myidtac2" ref(c) := idtac c. -Goal True. -myidtac2 True. -Abort. - -Tactic Notation "myidtac3" preident(s) := idtac s. -Goal True. -myidtac3 foo. -Abort. - -Tactic Notation "myidtac4" int_or_var(n) := idtac n. -Goal True. -myidtac4 3. -Abort. - -Tactic Notation "myidtac5" ident(id) := idtac id. -Goal True. -myidtac5 foo. -Abort. - - - diff --git a/test-suite/bugs/closed/5790.v b/test-suite/bugs/closed/5790.v deleted file mode 100644 index 6c93a3906e..0000000000 --- a/test-suite/bugs/closed/5790.v +++ /dev/null @@ -1,7 +0,0 @@ -Set Universe Polymorphism. -Section foo. -Context (v : Type). -Axiom a : True <-> False. - -Hint Resolve -> a. -End foo. diff --git a/test-suite/bugs/closed/5797.v b/test-suite/bugs/closed/5797.v deleted file mode 100644 index ee5ec1fa6a..0000000000 --- a/test-suite/bugs/closed/5797.v +++ /dev/null @@ -1,213 +0,0 @@ -Set Implicit Arguments. - -Open Scope type_scope. - -Inductive One : Set := inOne: One. - -Definition maybe: forall A B:Set,(A -> B) -> One + A -> One + B. -Proof. - intros A B f c. - case c. - left; assumption. - right; apply f; assumption. -Defined. - -Definition id (A:Set)(a:A):=a. - -Definition LamF (X: Set -> Set)(A:Set) :Set := - A + (X A)*(X A) + X(One + A). - -Definition LamF' (X: Set -> Set)(A:Set) :Set := - LamF X A. - -Require Import List. -Require Import Bool. - -Definition index := list bool. - -Inductive L (A:Set) : index -> Set := - initL: A -> L A nil - | pluslL: forall l:index, One -> L A (false::l) - | plusrL: forall l:index, L A l -> L A (false::l) - | varL: forall l:index, L A l -> L A (true::l) - | appL: forall l:index, L A (true::l) -> L A (true::l) -> L A (true::l) - | absL: forall l:index, L A (true::false::l) -> L A (true::l). - -Scheme L_rec_simp := Minimality for L Sort Set. - -Definition Lam' (A:Set) := L A (true::nil). - -Definition aczelapp: forall (l1 l2: index)(A:Set), L (L A l2) l1 -> L A - (l1++l2). -Proof. - intros l1 l2 A. - generalize l1. - clear l1. - (* Check (fun i:index => L A (i++l2)). *) - apply (L_rec_simp (A:=L A l2) (fun i:index => L A (i++l2))). - trivial. - intros l o. - simpl app. - apply pluslL; assumption. - intros l _ t. - simpl app. - apply plusrL; assumption. - intros l _ t. - simpl app. - apply varL; assumption. - intros l _ t1 _ t2. - simpl app in *|-*. - Check 0. - apply appL; [exact t1| exact t2]. - intros l _ t. - simpl app in *|-*. - Check 0. - apply absL; assumption. -Defined. - -Definition monL: forall (l:index)(A:Set)(B:Set), (A->B) -> L A l -> L B l. -Proof. - intros l A B f. - intro t. - elim t. - intro a. - exact (initL (f a)). - intros i u. - exact (pluslL _ _ u). - intros i _ r. - exact (plusrL r). - intros i _ r. - exact (varL r). - intros i _ r1 _ r2. - exact (appL r1 r2). - intros i _ r. - exact (absL r). -Defined. - -Definition lam': forall (A B:Set), (A -> B) -> Lam' A -> Lam' B. -Proof. - intros A B f t. - unfold Lam' in *|-*. - Check 0. - exact (monL f t). -Defined. - -Definition inLam': forall A:Set, LamF' Lam' A -> Lam' A. -Proof. - intros A [[a|[t1 t2]]|r]. - unfold Lam'. - exact (varL (initL a)). - exact (appL t1 t2). - unfold Lam' in * |- *. - Check 0. - apply absL. - change (L A ((true::nil) ++ (false::nil))). - apply aczelapp. - (* Check (fun x:One + A => (match (maybe (fun a:A => initL a) x) with - | inl u => pluslL _ _ u - | inr t' => plusrL t' end)). *) - exact (monL (fun x:One + A => - (match (maybe (fun a:A => initL a) x) with - | inl u => pluslL _ _ u - | inr t' => plusrL t' end)) r). -Defined. - -Section minimal. - -Definition sub1 (F G: Set -> Set):= forall A:Set, F A->G A. -Hypothesis G: Set -> Set. -Hypothesis step: sub1 (LamF' G) G. - -Fixpoint L'(A:Set)(i:index){struct i} : Set := - match i with - nil => A - | false::l => One + L' A l - | true::l => G (L' A l) - end. - -Definition LinL': forall (A:Set)(i:index), L A i -> L' A i. -Proof. - intros A i t. - elim t. - intro a. - unfold L'. - assumption. - intros l u. - left; assumption. - intros l _ r. - right; assumption. - intros l _ r. - apply (step (A:=L' A l)). - exact (inl _ (inl _ r)). - intros l _ r1 _ r2. - apply (step (A:=L' A l)). - (* unfold L' in * |- *. - Check 0. *) - exact (inl _ (inr _ (pair r1 r2))). - intros l _ r. - apply (step (A:=L' A l)). - exact (inr _ r). -Defined. - -Definition L'inG: forall A: Set, L' A (true::nil) -> G A. -Proof. - intros A t. - unfold L' in t. - assumption. -Defined. - -Definition Itbasic: sub1 Lam' G. -Proof. - intros A t. - apply L'inG. - unfold Lam' in t. - exact (LinL' t). -Defined. - -End minimal. - -Definition recid := Itbasic inLam'. - -Definition L'Lam'inL: forall (i:index)(A:Set), L' Lam' A i -> L A i. -Proof. - intros i A t. - induction i. - unfold L' in t. - apply initL. - assumption. - induction a. - simpl L' in t. - apply (aczelapp (l1:=true::nil) (l2:=i)). - exact (lam' IHi t). - simpl L' in t. - induction t. - exact (pluslL _ _ a). - exact (plusrL (IHi b)). -Defined. - - -Lemma recidgen: forall(A:Set)(i:index)(t:L A i), L'Lam'inL i A (LinL' inLam' t) - = t. -Proof. - intros A i t. - induction t. - trivial. - trivial. - simpl. - rewrite IHt. - trivial. - simpl L'Lam'inL. - rewrite IHt. - trivial. - simpl L'Lam'inL. - simpl L'Lam'inL in IHt1. - unfold lam' in IHt1. - simpl L'Lam'inL in IHt2. - unfold lam' in IHt2. - - (* going on. This fails for the original solution. *) - rewrite IHt1. - rewrite IHt2. - trivial. -Abort. (* one goal still left *) - diff --git a/test-suite/bugs/closed/5845.v b/test-suite/bugs/closed/5845.v deleted file mode 100644 index ea3347a851..0000000000 --- a/test-suite/bugs/closed/5845.v +++ /dev/null @@ -1,7 +0,0 @@ -Parameter P : forall n : nat, n=n -> Prop. - -Goal Prop. - refine (P _ _). - instantiate (1:=0). - trivial. -Qed. diff --git a/test-suite/bugs/closed/5940.v b/test-suite/bugs/closed/5940.v deleted file mode 100644 index 32c78b4b9e..0000000000 --- a/test-suite/bugs/closed/5940.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Setoid. - -Parameter P : nat -> Prop. -Parameter Q : nat -> Prop. -Parameter PQ : forall n, P n <-> Q n. - -Lemma PQ2 : forall n, P n -> Q n. - intros. - rewrite PQ in H. - trivial. -Qed. - diff --git a/test-suite/bugs/closed/6070.v b/test-suite/bugs/closed/6070.v deleted file mode 100644 index 49b16f6254..0000000000 --- a/test-suite/bugs/closed/6070.v +++ /dev/null @@ -1,32 +0,0 @@ -(* A slight shortening of bug 6078 *) - -(* This bug exposed a different behavior of unshelve_unifiable - depending on which projection is found in the unification - heuristics *) - -Axiom flat_type : Type. -Axiom interp_flat_type : flat_type -> Type. -Inductive type := Arrow (_ _ : flat_type). -Definition interp_type (t : type) - := interp_flat_type (match t with Arrow s d => s end) - -> interp_flat_type (match t with Arrow s d => d end). -Axiom Expr : type -> Type. -Axiom Interp : forall {t : type}, Expr t -> interp_type t. -Axiom Wf : forall {t}, Expr t -> Prop. -Axiom a : forall f, interp_flat_type f. - -Definition packaged_expr_functionP A := - (fun F : Expr A -> Expr A - => forall e' v, Interp (F e') v = a (let (_,f) := A in f)). -Goal forall (f f0 : flat_type) - (e : forall _ : Expr (@Arrow f f0), - Expr (@Arrow f f0)), - @packaged_expr_functionP (@Arrow f f0) e. - intros. - refine (fun (e0 : Expr (Arrow f f0)) - => (fun zHwf':True => - (fun v : interp_flat_type f => - ?[G] : ?[U] = ?[V] :> interp_flat_type ?[v])) ?[H]); - [ | ]. - (* Was: Error: Tactic failure: Incorrect number of goals (expected 3 tactics). *) -Abort. diff --git a/test-suite/bugs/closed/6129.v b/test-suite/bugs/closed/6129.v deleted file mode 100644 index e4a2a2ba95..0000000000 --- a/test-suite/bugs/closed/6129.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Make definition of coercions compatible with local definitions. *) - -Record foo (x : Type) (y:=1) := { foo_nat :> nat }. -Record foo2 (x : Type) (y:=1) (z t: Type) := { foo_nat2 :> nat }. -Record foo3 (y:=1) (z t: Type) := { foo_nat3 :> nat }. - -Check fun x : foo nat => x + 1. -Check fun x : foo2 nat nat nat => x + 1. -Check fun x : foo3 nat nat => x + 1. diff --git a/test-suite/bugs/closed/6191.v b/test-suite/bugs/closed/6191.v deleted file mode 100644 index e0d912509b..0000000000 --- a/test-suite/bugs/closed/6191.v +++ /dev/null @@ -1,16 +0,0 @@ -(* Check a 8.7.1 regression in ring_simplify *) - -Require Import ArithRing BinNat. -Goal forall f x, (2+x+f (N.to_nat 2)+3=4). -intros. -ring_simplify (2+x+f (N.to_nat 2)+3). -match goal with |- x + f (N.to_nat 2) + 5 = 4 => idtac end. -Abort. - -Require Import ZArithRing BinInt. -Open Scope Z_scope. -Goal forall x, (2+x+3=4). -intros. -ring_simplify (2+x+3). -match goal with |- x+5 = 4 => idtac end. -Abort. diff --git a/test-suite/bugs/closed/6297.v b/test-suite/bugs/closed/6297.v deleted file mode 100644 index a28607058f..0000000000 --- a/test-suite/bugs/closed/6297.v +++ /dev/null @@ -1,8 +0,0 @@ -Set Printing Universes. - -(* Error: Anomaly "Uncaught exception "Anomaly: Incorrect universe Set - declared for inductive type, inferred level is max(Prop, Set+1)."." - Please report at http://coq.inria.fr/bugs/. *) -Fail Record LTS: Set := - lts { St: Set; - init: St }. diff --git a/test-suite/bugs/closed/6313.v b/test-suite/bugs/closed/6313.v deleted file mode 100644 index 4d263c5a82..0000000000 --- a/test-suite/bugs/closed/6313.v +++ /dev/null @@ -1,64 +0,0 @@ -(* Former open goals in nested proofs were lost *) - -(* This used to fail with "Incorrect number of goals (expected 1 tactic)." *) - -Inductive foo := a | b | c. -Goal foo -> foo. - intro x. - simple refine (match x with - | a => _ - | b => ltac:(exact b) - | c => _ - end); [exact a|exact c]. -Abort. - -(* This used to leave the goal on the shelf and fails at reflexivity *) - -Goal (True/\0=0 -> True) -> True. - intro f. - refine - (f ltac:(split; only 1:exact I)). - reflexivity. -Qed. - -(* The "Unshelve" used to not see the explicitly "shelved" goal *) - -Lemma f (b:comparison) : b=b. -refine (match b with - Eq => ltac:(shelve) - | Lt => ltac:(give_up) - | Gt => _ - end). -exact (eq_refl Gt). -Unshelve. -exact (eq_refl Eq). -Fail auto. (* Check that there are no more regular subgoals *) -Admitted. - -(* The "Unshelve" used to not see the explicitly "shelved" goal *) - -Lemma f2 (b:comparison) : b=b. -refine (match b with - Eq => ltac:(shelve) - | Lt => ltac:(give_up) - | Gt => _ - end). -Unshelve. (* Note: Unshelve puts goals at the end *) -exact (eq_refl Gt). -exact (eq_refl Eq). -Fail auto. (* Check that there are no more regular subgoals *) -Admitted. - -(* The "unshelve" used to not see the explicitly "shelved" goal *) - -Lemma f3 (b:comparison) : b=b. -unshelve refine (match b with - Eq => ltac:(shelve) - | Lt => ltac:(give_up) - | Gt => _ - end). -(* Note: unshelve puts goals at the beginning *) -exact (eq_refl Eq). -exact (eq_refl Gt). -Fail auto. (* Check that there are no more regular subgoals *) -Admitted. diff --git a/test-suite/bugs/closed/6323.v b/test-suite/bugs/closed/6323.v deleted file mode 100644 index fdc33befc6..0000000000 --- a/test-suite/bugs/closed/6323.v +++ /dev/null @@ -1,9 +0,0 @@ -Goal True. - simple refine (let X : Type := _ in _); - [ abstract exact Set using Set' - | let X' := (eval cbv delta [X] in X) in - clear X; - simple refine (let id' : { x : X' | True } -> X' := _ in _); - [ abstract refine (@proj1_sig _ _) | ] - ]. -Abort. diff --git a/test-suite/bugs/closed/6378.v b/test-suite/bugs/closed/6378.v deleted file mode 100644 index 68ae7961dd..0000000000 --- a/test-suite/bugs/closed/6378.v +++ /dev/null @@ -1,18 +0,0 @@ -Require Import Coq.ZArith.ZArith. -Ltac profile_constr tac := - let dummy := match goal with _ => reset ltac profile; start ltac profiling end in - let ret := match goal with _ => tac () end in - let dummy := match goal with _ => stop ltac profiling; show ltac profile end in - pose 1. - -Ltac slow _ := eval vm_compute in (Z.div_eucl, Z.div_eucl, Z.div_eucl, Z.div_eucl, Z.div_eucl). - -Goal True. - start ltac profiling. - reset ltac profile. - reset ltac profile. - stop ltac profiling. - time profile_constr slow. - show ltac profile cutoff 0. - show ltac profile "slow". -Abort. diff --git a/test-suite/bugs/closed/6490.v b/test-suite/bugs/closed/6490.v deleted file mode 100644 index dcf9ff29ed..0000000000 --- a/test-suite/bugs/closed/6490.v +++ /dev/null @@ -1,4 +0,0 @@ -Inductive Foo (A' := I) (B : Type) := foo : Foo B. - -Goal Foo True. dtauto. Qed. -Goal Foo True. firstorder. Qed. diff --git a/test-suite/bugs/closed/6529.v b/test-suite/bugs/closed/6529.v deleted file mode 100644 index 8d90819998..0000000000 --- a/test-suite/bugs/closed/6529.v +++ /dev/null @@ -1,16 +0,0 @@ -Require Import Vector Program. - -Program Definition append_nil_def := - forall A n (ls: t A n), append ls (nil A) = ls. (* Works *) - -Lemma append_nil : append_nil_def. (* Works *) -Proof. -Admitted. - -Program Lemma append_nil' : - forall A n (ls: t A n), append ls (nil A) = ls. -Abort. - -Fail Program Lemma append_nil'' : - forall A B n (ls: t A n), append ls (nil A) = ls. -(* Error: Anomaly "Evar ?X25 was not declared." Please report at http://coq.inria.fr/bugs/. *) diff --git a/test-suite/bugs/closed/6534.v b/test-suite/bugs/closed/6534.v deleted file mode 100644 index f5013994c5..0000000000 --- a/test-suite/bugs/closed/6534.v +++ /dev/null @@ -1,7 +0,0 @@ -Goal forall x : nat, x = x. -Proof. -intros x. -refine ((fun x x => _ tt) tt tt). -let t := match goal with [ |- ?P ] => P end in -let _ := type of t in -idtac. diff --git a/test-suite/bugs/closed/6617.v b/test-suite/bugs/closed/6617.v deleted file mode 100644 index 9cabd62d48..0000000000 --- a/test-suite/bugs/closed/6617.v +++ /dev/null @@ -1,34 +0,0 @@ -Definition MR {T M : Type} := -fun (R : M -> M -> Prop) (m : T -> M) (x y : T) => R (m x) (m y). - -Set Primitive Projections. - -Record sigma {A : Type} {B : A -> Type} : Type := sigmaI - { pr1 : A; pr2 : B pr1 }. - -Axiom F : forall {A : Type} {R : A -> A -> Prop}, - (forall x, (forall y, R y x -> unit) -> unit) -> forall (x : A), unit. - -Definition foo (A : Type) (l : list A) := - let y := {| pr1 := A; pr2 := l |} in - let bar := MR lt (fun p : sigma => - (fix Ffix (x : list (pr1 p)) : nat := - match x with - | nil => 0 - | cons _ x1 => S (Ffix x1) - end) (pr2 p)) in -fun (_ : bar y y) => -F (fun (r : sigma) - (X : forall q : sigma, bar q r -> unit) => tt). - -Definition fooT (A : Type) (l : list A) : Type := - ltac:(let ty := type of (foo A l) in exact ty). -Parameter P : forall A l, fooT A l -> Prop. - -Goal forall A l, P A l (foo A l). -Proof. - intros; unfold foo. - Fail match goal with - | [ |- context [False]] => idtac - end. -Admitted. diff --git a/test-suite/bugs/closed/6631.v b/test-suite/bugs/closed/6631.v deleted file mode 100644 index 100dc13fc8..0000000000 --- a/test-suite/bugs/closed/6631.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Coq.derive.Derive. - -Derive f SuchThat (f = 1 + 1) As feq. -Proof. - transitivity 2; [refine (eq_refl 2)|]. - transitivity 2. - 2:abstract exact (eq_refl 2). diff --git a/test-suite/bugs/closed/6634.v b/test-suite/bugs/closed/6634.v deleted file mode 100644 index 7f33afcc2f..0000000000 --- a/test-suite/bugs/closed/6634.v +++ /dev/null @@ -1,6 +0,0 @@ -From Coq Require Import ssreflect. - -Lemma normalizeP (p : tt = tt) : p = p. -Proof. -Fail move: {2} tt p. -Abort. diff --git a/test-suite/bugs/closed/6661.v b/test-suite/bugs/closed/6661.v deleted file mode 100644 index e88a3704d8..0000000000 --- a/test-suite/bugs/closed/6661.v +++ /dev/null @@ -1,259 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-noinit" "-indices-matter" "-w" "-notation-overridden,-deprecated-option") -*- *) -(* - The Coq Proof Assistant, version 8.7.1 (January 2018) - compiled on Jan 21 2018 15:02:24 with OCaml 4.06.0 - from commit 391bb5e196901a3a9426295125b8d1c700ab6992 - *) - - -Require Export Coq.Init.Notations. -Notation "'∏' x .. y , P" := (forall x, .. (forall y, P) ..) - (at level 200, x binder, y binder, right associativity) : type_scope. -Notation "'λ' x .. y , t" := (fun x => .. (fun y => t) ..) - (at level 200, x binder, y binder, right associativity). -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Reserved Notation "p @ q" (at level 60, right associativity). -Reserved Notation "! p " (at level 50). - -Monomorphic Universe uu. -Monomorphic Universe uu0. -Monomorphic Universe uu1. -Constraint uu0 < uu1. - -Global Set Universe Polymorphism. -Global Set Polymorphic Inductive Cumulativity. -Global Unset Universe Minimization ToSet. - -Notation UU := Type (only parsing). -Notation UU0 := Type@{uu0} (only parsing). - -Global Set Printing Universes. - - Inductive unit : UU0 := tt : unit. - -Inductive paths@{i} {A:Type@{i}} (a:A) : A -> Type@{i} := idpath : paths a a. -Hint Resolve idpath : core . -Notation "a = b" := (paths a b) (at level 70, no associativity) : type_scope. - -Set Primitive Projections. -Set Nonrecursive Elimination Schemes. - -Record total2@{i} { T: Type@{i} } ( P: T -> Type@{i} ) : Type@{i} - := tpair { pr1 : T; pr2 : P pr1 }. - -Arguments tpair {_} _ _ _. -Arguments pr1 {_ _} _. -Arguments pr2 {_ _} _. - -Notation "'∑' x .. y , P" := (total2 (λ x, .. (total2 (λ y, P)) ..)) - (at level 200, x binder, y binder, right associativity) : type_scope. - -Definition foo (X:Type) (xy : @total2 X (λ _, X)) : X. - induction xy as [x y]. - exact x. -Defined. - -Unset Automatic Introduction. - -Definition idfun (T : UU) := λ t:T, t. - -Definition pathscomp0 {X : UU} {a b c : X} (e1 : a = b) (e2 : b = c) : a = c. -Proof. - intros. induction e1. exact e2. -Defined. - -Hint Resolve @pathscomp0 : pathshints. - -Notation "p @ q" := (pathscomp0 p q). - -Definition pathsinv0 {X : UU} {a b : X} (e : a = b) : b = a. -Proof. - intros. induction e. exact (idpath _). -Defined. - -Notation "! p " := (pathsinv0 p). - -Definition maponpaths {T1 T2 : UU} (f : T1 -> T2) {t1 t2 : T1} - (e: t1 = t2) : f t1 = f t2. -Proof. - intros. induction e. exact (idpath _). -Defined. - -Definition map_on_two_paths {X Y Z : UU} (f : X -> Y -> Z) {x x' y y'} (ex : x = x') (ey: y = y') : - f x y = f x' y'. -Proof. - intros. induction ex. induction ey. exact (idpath _). -Defined. - - -Definition maponpathscomp0 {X Y : UU} {x1 x2 x3 : X} - (f : X -> Y) (e1 : x1 = x2) (e2 : x2 = x3) : - maponpaths f (e1 @ e2) = maponpaths f e1 @ maponpaths f e2. -Proof. - intros. induction e1. induction e2. exact (idpath _). -Defined. - -Definition maponpathsinv0 {X Y : UU} (f : X -> Y) - {x1 x2 : X} (e : x1 = x2) : maponpaths f (! e) = ! (maponpaths f e). -Proof. - intros. induction e. exact (idpath _). -Defined. - - - -Definition constr1 {X : UU} (P : X -> UU) {x x' : X} (e : x = x') : - ∑ (f : P x -> P x'), - ∑ (ee : ∏ p : P x, tpair _ x p = tpair _ x' (f p)), - ∏ (pp : P x), maponpaths pr1 (ee pp) = e. -Proof. - intros. induction e. - split with (idfun (P x)). - split with (λ p, idpath _). - unfold maponpaths. simpl. - intro. exact (idpath _). -Defined. - -Definition transportf@{i} {X : Type@{i}} (P : X -> Type@{i}) {x x' : X} - (e : x = x') : P x -> P x' := pr1 (constr1 P e). - -Lemma two_arg_paths_f@{i} {A : Type@{i}} {B : A -> Type@{i}} {C:Type@{i}} {f : ∏ a, B a -> C} {a1 b1 a2 b2} - (p : a1 = a2) (q : transportf B p b1 = b2) : f a1 b1 = f a2 b2. -Proof. - intros. induction p. induction q. exact (idpath _). -Defined. - -Definition iscontr@{i} (T:Type@{i}) : Type@{i} := ∑ cntr:T, ∏ t:T, t=cntr. - -Lemma proofirrelevancecontr {X : UU} (is : iscontr X) (x x' : X) : x = x'. -Proof. - intros. - induction is as [y fe]. - exact (fe x @ !(fe x')). -Defined. - - -Definition hfiber@{i} {X Y : Type@{i}} (f : X -> Y) (y : Y) : Type@{i} := total2 (λ x, f x = y). - -Definition hfiberpair {X Y : UU} (f : X -> Y) {y : Y} - (x : X) (e : f x = y) : hfiber f y := - tpair _ x e. - -Definition coconustot (T : UU) (t : T) := ∑ t' : T, t' = t. - -Definition coconustotpair (T : UU) {t t' : T} (e: t' = t) : coconustot T t - := tpair _ t' e. - -Lemma connectedcoconustot {T : UU} {t : T} (c1 c2 : coconustot T t) : c1 = c2. -Proof. - intros. - induction c1 as [x0 x]. - induction x. - induction c2 as [x1 y]. - induction y. - exact (idpath _). -Defined. - -Definition isweq@{i} {X Y : Type@{i}} (f : X -> Y) : Type@{i} := - ∏ y : Y, iscontr (hfiber f y). - -Lemma isProofIrrelevantUnit : ∏ x x' : unit, x = x'. -Proof. - intros. induction x. induction x'. exact (idpath _). -Defined. - -Lemma unitl0 : tt = tt -> coconustot _ tt. -Proof. - intros e. exact (coconustotpair unit e). -Defined. - -Lemma unitl1: coconustot _ tt -> tt = tt. -Proof. - intro cp. induction cp as [x t]. induction x. exact t. -Defined. - -Lemma unitl2: ∏ e : tt = tt, unitl1 (unitl0 e) = e. -Proof. - intros. unfold unitl0. simpl. exact (idpath _). -Defined. - -Lemma unitl3: ∏ e : tt = tt, e = idpath tt. -Proof. - intros. - - assert (e0 : unitl0 (idpath tt) = unitl0 e). - { simple refine (connectedcoconustot _ _). } - - set (e1 := maponpaths unitl1 e0). - - exact (! (unitl2 e) @ (! e1) @ (unitl2 (idpath _))). -Defined. - -Theorem iscontrpathsinunit (x x' : unit) : iscontr (x = x'). -Proof. - intros. - split with (isProofIrrelevantUnit x x'). - intros e'. - induction x. - induction x'. - simpl. - apply unitl3. -Qed. - -Lemma ifcontrthenunitl0 (e1 e2 : tt = tt) : e1 = e2. -Proof. - intros. - simple refine (proofirrelevancecontr _ _ _). - exact (iscontrpathsinunit tt tt). -Qed. - -Section isweqcontrtounit. - - Universe i. - - (* To see the bug, run it both with and without this constraint: *) - - (* Constraint uu0 < i. *) - - (* Without this constraint, we get i = uu0 in the next definition *) - Lemma isweqcontrtounit@{} {T : Type@{i}} (is : iscontr@{i} T) : isweq@{i} (λ _:T, tt). - Proof. - intros. intro y. induction y. - induction is as [c h]. - split with (hfiberpair@{i i i} _ c (idpath tt)). - intros ha. - induction ha as [x e]. - simple refine (two_arg_paths_f (h x) _). - simple refine (ifcontrthenunitl0 _ _). - Defined. - - (* - Explanation of the bug: - - With the constraint uu0 < i above we get: - - |= uu0 <= bug.3 - uu0 <= i - uu1 <= i - i <= bug.3 - - from this print statement: *) - - Print isweqcontrtounit. - - (* - - Without the constraint uu0 < i above we get: - - |= i <= bug.3 - uu0 = i - - Since uu0 = i is not inferred when we impose the constraint uu0 < i, - it is invalid to infer it when we don't. - - *) - - Context (X : Type@{uu1}). - - Check (@isweqcontrtounit X). (* detect a universe inconsistency *) - -End isweqcontrtounit. diff --git a/test-suite/bugs/closed/6677.v b/test-suite/bugs/closed/6677.v deleted file mode 100644 index 99e47bb87c..0000000000 --- a/test-suite/bugs/closed/6677.v +++ /dev/null @@ -1,5 +0,0 @@ -Set Universe Polymorphism. - -Definition T@{i} := Type@{i}. -Fail Definition U@{i} := (T@{i} <: Type@{i}). -Fail Definition eqU@{i j} : @eq T@{j} U@{i} T@{i} := eq_refl. diff --git a/test-suite/bugs/closed/6770.v b/test-suite/bugs/closed/6770.v deleted file mode 100644 index 9bcc740830..0000000000 --- a/test-suite/bugs/closed/6770.v +++ /dev/null @@ -1,7 +0,0 @@ -Section visibility. - - Let Fixpoint by_proof (n:nat) : True. - Proof. exact I. Defined. -End visibility. - -Fail Check by_proof. diff --git a/test-suite/bugs/closed/6774.v b/test-suite/bugs/closed/6774.v deleted file mode 100644 index 9625af91f5..0000000000 --- a/test-suite/bugs/closed/6774.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Was an anomaly with ill-typed template polymorphism *) -Definition huh (b:bool) := if b then Set else Prop. -Definition lol b: huh b := - if b return huh b then nat else True. -Goal (lol true) * unit. -Fail generalize true. (* should fail with error, not anomaly *) -Abort. diff --git a/test-suite/bugs/closed/6775.v b/test-suite/bugs/closed/6775.v deleted file mode 100644 index 206df23bce..0000000000 --- a/test-suite/bugs/closed/6775.v +++ /dev/null @@ -1,43 +0,0 @@ -(* Issue caused and fixed during the lifetime of #6775: unification - failing on partially applied cumulative inductives. *) - -Set Universe Polymorphism. - -Set Polymorphic Inductive Cumulativity. - -Unset Elimination Schemes. - -Inductive paths@{i} {A : Type@{i}} (a : A) : A -> Type@{i} := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Arguments inverse {A x y} p : simpl nomatch. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Arguments concat {A x y z} p q : simpl nomatch. - -Notation "1" := idpath. - -Reserved Notation "p @ q" (at level 20). -Notation "p @ q" := (concat p q). - -Reserved Notation "p ^" (at level 3, format "p '^'"). -Notation "p ^" := (inverse p). - -Definition concat_pV_p {A} {x y z : A} (p : x = z) (q : y = z) : - (p @ q^) @ q = p - := - (match q as i return forall p, (p @ i^) @ i = p with - idpath => - fun p => - match p with idpath => 1 end - end) p. diff --git a/test-suite/bugs/closed/6878.v b/test-suite/bugs/closed/6878.v deleted file mode 100644 index 70f1b3127a..0000000000 --- a/test-suite/bugs/closed/6878.v +++ /dev/null @@ -1,8 +0,0 @@ - -Set Universe Polymorphism. -Module Type T. - Axiom foo : Prop. -End T. - -(** Used to anomaly *) -Fail Module M : T with Definition foo := Type. diff --git a/test-suite/bugs/closed/6910.v b/test-suite/bugs/closed/6910.v deleted file mode 100644 index 5167a5364a..0000000000 --- a/test-suite/bugs/closed/6910.v +++ /dev/null @@ -1,5 +0,0 @@ -From Coq Require Import ssreflect ssrfun. - -(* We should be able to use Some_inj as a view: *) -Lemma foo (x y : nat) : Some x = Some y -> x = y. -Proof. by move/Some_inj. Qed. diff --git a/test-suite/bugs/closed/6951.v b/test-suite/bugs/closed/6951.v deleted file mode 100644 index 419f8d7c4e..0000000000 --- a/test-suite/bugs/closed/6951.v +++ /dev/null @@ -1,2 +0,0 @@ -Record float2 : Set := Float2 { Fnum : unit }. -Scheme Equality for float2. diff --git a/test-suite/bugs/closed/6956.v b/test-suite/bugs/closed/6956.v deleted file mode 100644 index ee21adbbfd..0000000000 --- a/test-suite/bugs/closed/6956.v +++ /dev/null @@ -1,13 +0,0 @@ -(** Used to trigger an anomaly with VM compilation *) - -Set Universe Polymorphism. - -Inductive t A : nat -> Type := -| nil : t A 0 -| cons : forall (h : A) (n : nat), t A n -> t A (S n). - -Definition case0 {A} (P : t A 0 -> Type) (H : P (nil A)) v : P v := -match v with -| nil _ => H -| _ => fun devil => False_ind (@IDProp) devil -end. diff --git a/test-suite/bugs/closed/7011.v b/test-suite/bugs/closed/7011.v deleted file mode 100644 index 296e4e11e5..0000000000 --- a/test-suite/bugs/closed/7011.v +++ /dev/null @@ -1,16 +0,0 @@ -(* Fix and Cofix were missing in tactic unification *) - -Goal exists e, (fix foo (n : nat) : nat := match n with O => e | S n' => foo n' end) - = (fix foo (n : nat) : nat := match n with O => O | S n' => foo n' end). -Proof. - eexists. - reflexivity. -Qed. - -CoInductive stream := cons : nat -> stream -> stream. - -Goal exists e, (cofix foo := cons e foo) = (cofix foo := cons 0 foo). -Proof. - eexists. - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/7068.v b/test-suite/bugs/closed/7068.v deleted file mode 100644 index 9fadb195bf..0000000000 --- a/test-suite/bugs/closed/7068.v +++ /dev/null @@ -1,6 +0,0 @@ -(* These tests are only about a subset of #7068 *) -(* The original issue is still open *) - -Inductive foo : let T := Type in T := . -Definition bob1 := Eval vm_compute in foo_rect. -Definition bob2 := Eval native_compute in foo_rect. diff --git a/test-suite/bugs/closed/7076.v b/test-suite/bugs/closed/7076.v deleted file mode 100644 index 0abc88c282..0000000000 --- a/test-suite/bugs/closed/7076.v +++ /dev/null @@ -1,4 +0,0 @@ -(* These calls were raising an anomaly at some time *) -Inductive A : nat -> id (nat->Type) := . -Eval vm_compute in fun x => match x in A y z return y = z with end. -Eval native_compute in fun x => match x in A y z return y = z with end. diff --git a/test-suite/bugs/closed/7092.v b/test-suite/bugs/closed/7092.v deleted file mode 100644 index d90de8b932..0000000000 --- a/test-suite/bugs/closed/7092.v +++ /dev/null @@ -1,70 +0,0 @@ -(* Examples matching fix/cofix in Ltac pattern-matching *) - -Goal True. -lazymatch (eval cbv delta [Nat.add] in Nat.add) with -| (fix F (n : nat) (v : ?A) {struct n} : @?P n v - := match n with - | O => @?O_case v - | S n' => @?S_case n' v F - end) - => - unify A nat; - unify P (fun _ _ : nat => nat); - unify O_case (fun v : nat => v); - unify S_case (fun (p : nat) (m : nat) (add : nat -> nat -> nat) - => S (add p m)) - end. -Abort. - -Fixpoint f l n := match n with 0 => 0 | S n => g n (cons n l) end -with g n l := match n with 0 => 1 | S n => f (cons 0 l) n end. - -Goal True. - -lazymatch (eval cbv delta [f] in f) with -| fix myf (l : ?L) (n : ?N) {struct n} : nat := - match n as _ with - | 0 => ?Z - | S n0 => @?S myf myg n0 l - end - with myg (n' : ?N') (l' : ?L') {struct n'} : nat := - match n' as _ with - | 0 => ?Z' - | S n0' => @?S' myf myg n0' l' - end - for myf => - unify L (list nat); - unify L' (list nat); - unify N nat; - unify N' nat; - unify Z 0; - unify Z' 1; - unify S (fun (f : L -> N -> nat) (g : N -> L -> nat) n l => g n (cons n l)); - unify S' (fun (f : L -> N -> nat) (g : N -> L -> nat) (n:N) l => f (cons 0 l) n) -end. - -Abort. - -CoInductive S1 := C1 : nat -> S2 -> S1 with S2 := C2 : bool -> S1 -> S2. - -CoFixpoint f' n l := C1 n (g' (cons n l) n n) -with g' l n p := C2 true (f' (S n) l). - -Goal True. - -lazymatch (eval cbv delta [f'] in f') with -| cofix myf (n : ?N) (l : ?L) : ?T := @?X n g l - with g (l' : ?L') (n' : ?N') (p' : ?N'') : ?T' := @?X' n' myf l' - for myf => - unify L (list nat); - unify L' (list nat); - unify N nat; - unify N' nat; - unify N'' nat; - unify T S1; - unify T' S2; - unify X (fun n g l => C1 n (g (cons n l) n n)); - unify X' (fun n f (l : list nat) => C2 true (f (S n) l)) -end. - -Abort. diff --git a/test-suite/bugs/closed/7113.v b/test-suite/bugs/closed/7113.v deleted file mode 100644 index 976e60f20c..0000000000 --- a/test-suite/bugs/closed/7113.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import Program.Tactics. -Section visibility. - - (* used to anomaly *) - Program Let Fixpoint ev' (n : nat) : bool := _. - Next Obligation. exact true. Qed. - - Check ev'. -End visibility. -Fail Check ev'. diff --git a/test-suite/bugs/closed/7195.v b/test-suite/bugs/closed/7195.v deleted file mode 100644 index ea97747ac9..0000000000 --- a/test-suite/bugs/closed/7195.v +++ /dev/null @@ -1,12 +0,0 @@ -(* A disjoint-names condition was missing when matching names in Ltac - pattern-matching *) - -Goal True. - let x := (eval cbv beta zeta in (fun P => let Q := P in fun P => P + Q)) in - unify x (fun a b => b + a); (* success *) - let x' := lazymatch x with - | (fun (a : ?A) (b : ?B) => ?k) - => constr:(fun (a : A) (b : B) => k) - end in - unify x x'. -Abort. diff --git a/test-suite/bugs/closed/7333.v b/test-suite/bugs/closed/7333.v deleted file mode 100644 index fba5b9029d..0000000000 --- a/test-suite/bugs/closed/7333.v +++ /dev/null @@ -1,39 +0,0 @@ -Module Example1. - -CoInductive wrap : Type := - | item : unit -> wrap. - -Definition extract (t : wrap) : unit := -match t with -| item x => x -end. - -CoFixpoint close u : unit -> wrap := -match u with -| tt => item -end. - -Definition table : wrap := close tt tt. - -Eval vm_compute in (extract table). -Eval vm_compute in (extract table). - -End Example1. - -Module Example2. - -Set Primitive Projections. -CoInductive wrap : Type := - item { extract : unit }. - -CoFixpoint close u : unit -> wrap := -match u with -| tt => item -end. - -Definition table : wrap := close tt tt. - -Eval vm_compute in (extract table). -Eval vm_compute in (extract table). - -End Example2. diff --git a/test-suite/bugs/closed/7392.v b/test-suite/bugs/closed/7392.v deleted file mode 100644 index cf465c6588..0000000000 --- a/test-suite/bugs/closed/7392.v +++ /dev/null @@ -1,9 +0,0 @@ -Inductive R : nat -> Prop := ER : forall n, R n -> R (S n). - -Goal (forall (n : nat), R n -> False) -> True -> False. -Proof. -intros H0 H1. -eapply H0. -clear H1. -apply ER. -simpl. diff --git a/test-suite/bugs/closed/7421.v b/test-suite/bugs/closed/7421.v deleted file mode 100644 index afcdd35fcc..0000000000 --- a/test-suite/bugs/closed/7421.v +++ /dev/null @@ -1,39 +0,0 @@ - - -Universe i j. - -Goal False. -Proof. - Check Type@{i} : Type@{j}. - Fail constr_eq_strict Type@{i} Type@{j}. - assert_succeeds constr_eq Type@{i} Type@{j}. (* <- i=j is forgotten after assert_succeeds *) - Fail constr_eq_strict Type@{i} Type@{j}. - - constr_eq Type@{i} Type@{j}. (* <- i=j is retained *) - constr_eq_strict Type@{i} Type@{j}. - Fail Check Type@{i} : Type@{j}. - - Fail constr_eq Prop Set. - Fail constr_eq Prop Type. - - Fail constr_eq_strict Type Type. - constr_eq Type Type. - - constr_eq_strict Set Set. - constr_eq Set Set. - constr_eq Prop Prop. - - let x := constr:(Type) in constr_eq_strict x x. - let x := constr:(Type) in constr_eq x x. - - Fail lazymatch type of prod with - | ?A -> ?B -> _ => constr_eq_strict A B - end. - lazymatch type of prod with - | ?A -> ?B -> _ => constr_eq A B - end. - lazymatch type of prod with - | ?A -> ?B -> ?C => constr_eq A C - end. - -Abort. diff --git a/test-suite/bugs/closed/7462.v b/test-suite/bugs/closed/7462.v deleted file mode 100644 index 40ca39e38a..0000000000 --- a/test-suite/bugs/closed/7462.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Adding an only-printing notation should not override existing - interpretations for the same notation. *) - -Notation "$ x" := (@id nat x) (only parsing, at level 0). -Notation "$ x" := (@id bool x) (only printing, at level 0). -Check $1. (* Was: Error: Unknown interpretation for notation "$ _". *) - -(* Adding an only-printing notation should not let believe - that a parsing rule has been given *) - -Notation "$ x" := (@id bool x) (only printing, at level 0). -Notation "$ x" := (@id nat x) (only parsing, at level 0). -Check $1. (* Was: Error: Syntax Error: Lexer: Undefined token *) diff --git a/test-suite/bugs/closed/7554.v b/test-suite/bugs/closed/7554.v deleted file mode 100644 index 12b0aa2cb5..0000000000 --- a/test-suite/bugs/closed/7554.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Coq.Program.Tactics. - -(* these should not result in anomalies *) - -Fail Program Lemma foo: - forall P, forall H, forall (n:nat), P n. - -Fail Program Lemma foo: - forall a (P : list a -> Prop), forall H, forall (n:list a), P n. - -Fail Program Lemma foo: - forall (a : Type) (P : list a -> Prop), forall H, forall (n:list a), P n. diff --git a/test-suite/bugs/closed/7615.v b/test-suite/bugs/closed/7615.v deleted file mode 100644 index cd8c4ad7df..0000000000 --- a/test-suite/bugs/closed/7615.v +++ /dev/null @@ -1,19 +0,0 @@ -Set Universe Polymorphism. - -Module Type S. -Parameter Inline T@{i} : Type@{i+1}. -End S. - -Module F (X : S). -Definition X@{j i} : Type@{j} := X.T@{i}. -End F. - -Module M. -Definition T@{i} := Type@{i}. -End M. - -Module N := F(M). - -Require Import Hurkens. - -Fail Definition eqU@{i j} : @eq Type@{j} N.X@{i Set} Type@{i} := eq_refl. diff --git a/test-suite/bugs/closed/7631.v b/test-suite/bugs/closed/7631.v deleted file mode 100644 index 34eb8b8676..0000000000 --- a/test-suite/bugs/closed/7631.v +++ /dev/null @@ -1,21 +0,0 @@ -Module NamedContext. - -Definition foo := true. - -Section Foo. - -Let bar := foo. - -Eval native_compute in bar. - -End Foo. - -End NamedContext. - -Module RelContext. - -Definition foo := true. - -Definition bar (x := foo) := Eval native_compute in x. - -End RelContext. diff --git a/test-suite/bugs/closed/7695.v b/test-suite/bugs/closed/7695.v deleted file mode 100644 index 42bdb076b6..0000000000 --- a/test-suite/bugs/closed/7695.v +++ /dev/null @@ -1,20 +0,0 @@ -Require Import Hurkens. - -Universes i j k. -Module Type T. - Parameter T1 : Type@{i+1}. - Parameter e : Type@{j} = T1 : Type@{k}. -End T. - -Module M. - Definition T1 := Type@{j}. - Definition e : Type@{j} = T1 : Type@{k} := eq_refl. -End M. - -Module F (A:T). - Definition bad := TypeNeqSmallType.paradox _ A.e. -End F. - -Set Printing Universes. -Fail Module X := F M. -(* Universe inconsistency. Cannot enforce j <= i because i < Coq.Logic.Hurkens.105 = j. *) diff --git a/test-suite/bugs/closed/7700.v b/test-suite/bugs/closed/7700.v deleted file mode 100644 index 56f5481baa..0000000000 --- a/test-suite/bugs/closed/7700.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Abbreviations to section variables were not located *) -Section foo. - Let x := Set. - Notation y := x. - Check y. - Variable x' : Set. - Notation y' := x'. - Check y'. -End foo. diff --git a/test-suite/bugs/closed/7712.v b/test-suite/bugs/closed/7712.v deleted file mode 100644 index a4e9697fad..0000000000 --- a/test-suite/bugs/closed/7712.v +++ /dev/null @@ -1,4 +0,0 @@ -(* This used to raise an anomaly *) - -Fail Reserved Notation "'[tele_arg' x ';' .. ';' z ]" - (format "[tele_arg '[hv' x .. z ']' ]"). diff --git a/test-suite/bugs/closed/7723.v b/test-suite/bugs/closed/7723.v deleted file mode 100644 index 2162901231..0000000000 --- a/test-suite/bugs/closed/7723.v +++ /dev/null @@ -1,58 +0,0 @@ -Set Universe Polymorphism. - -Module Segfault. - -Inductive decision_tree : Type := . - -Fixpoint first_satisfying_helper {A B} (f : A -> option B) (ls : list A) : option B - := match ls with - | nil => None - | cons x xs - => match f x with - | Some v => Some v - | None => first_satisfying_helper f xs - end - end. - -Axiom admit : forall {T}, T. -Definition dtree4 : option decision_tree := - match first_satisfying_helper (fun pat : nat => Some pat) (cons 0 nil) - with - | Some _ => admit - | None => admit - end -. -Definition dtree'' := Eval vm_compute in dtree4. (* segfault *) - -End Segfault. - -Module OtherExample. - -Definition bar@{i} := Type@{i}. -Definition foo@{i j} (x y z : nat) := - @id Type@{j} bar@{i}. -Eval vm_compute in foo. - -End OtherExample. - -Module LocalClosure. - -Definition bar@{i} := Type@{i}. - -Definition foo@{i j} (x y z : nat) := - @id (nat -> Type@{j}) (fun _ => Type@{i}). -Eval vm_compute in foo. - -End LocalClosure. - -Require Import Hurkens. -Polymorphic Inductive unit := tt. - -Polymorphic Definition foo := - let x := id tt in (x, x, Type). - -Lemma bad : False. - refine (TypeNeqSmallType.paradox (snd foo) _). - vm_compute. - Fail reflexivity. -Abort. diff --git a/test-suite/bugs/closed/7754.v b/test-suite/bugs/closed/7754.v deleted file mode 100644 index 229df93773..0000000000 --- a/test-suite/bugs/closed/7754.v +++ /dev/null @@ -1,21 +0,0 @@ - -Set Universe Polymorphism. - -Module OK. - - Inductive one@{i j} : Type@{i} := - with two : Type@{j} := . - Check one@{Set Type} : Set. - Fail Check two@{Set Type} : Set. - -End OK. - -Module Bad. - - Fail Inductive one := - with two@{i +} : Type@{i} := . - - Fail Inductive one@{i +} := - with two@{i +} := . - -End Bad. diff --git a/test-suite/bugs/closed/7779.v b/test-suite/bugs/closed/7779.v deleted file mode 100644 index 78936b5958..0000000000 --- a/test-suite/bugs/closed/7779.v +++ /dev/null @@ -1,15 +0,0 @@ -(* Checking that the "in" clause takes the "eqn" clause into account *) - -Definition test (x: nat): {y: nat | False }. Admitted. - -Parameter x: nat. -Parameter z: nat. - -Goal - proj1_sig (test x) = z -> - False. -Proof. - intro H. - destruct (test x) eqn:Heqs in H. - change (test x = exist (fun _ : nat => False) x0 f) in Heqs. (* Check it has the expected statement *) -Abort. diff --git a/test-suite/bugs/closed/7780.v b/test-suite/bugs/closed/7780.v deleted file mode 100644 index 2318f4d6ec..0000000000 --- a/test-suite/bugs/closed/7780.v +++ /dev/null @@ -1,16 +0,0 @@ -(* A lift was missing in expanding aliases under binders for unification *) - -(* Below, the lift was missing while expanding the reference to - [mkcons] in [?N] which was under binder [arg] *) - -Goal forall T (t : T) (P P0 : T -> Set), option (option (list (P0 t)) -> option (list (P t))). - intros ????. - refine (Some - (fun rls - => let mkcons := ?[M] in - let default arg := ?[N] in - match rls as rls (* 2 *) return option (list (P ?[O])) with - | Some _ => None - | None => None - end)). -Abort. diff --git a/test-suite/bugs/closed/7795.v b/test-suite/bugs/closed/7795.v deleted file mode 100644 index 5db0f81cc5..0000000000 --- a/test-suite/bugs/closed/7795.v +++ /dev/null @@ -1,65 +0,0 @@ - - -Definition fwd (b: bool) A (e2: A): A. Admitted. - -Ltac destruct_refinement_aux T := - let m := fresh "mres" in - let r := fresh "r" in - let P := fresh "P" in - pose T as m; - destruct m as [ r P ]. - -Ltac destruct_refinement := - match goal with - | |- context[proj1_sig ?T] => destruct_refinement_aux T - end. - -Ltac t_base := discriminate || destruct_refinement. - - -Inductive List (T: Type) := -| Cons_construct: T -> List T -> List T -| Nil_construct: List T. - -Definition t (T: Type): List T. Admitted. -Definition size (T: Type) (src: List T): nat. Admitted. -Definition filter1_rt1_type (T: Type): Type := { res: List T | false = true }. -Definition filter1 (T: Type): filter1_rt1_type T. Admitted. - -Definition hh_1: - forall T : Type, - (forall (T0 : Type), - False -> filter1_rt1_type T0) -> - False. -Admitted. - -Definition hh_2: - forall (T : Type), - filter1_rt1_type T -> - filter1_rt1_type T. -Admitted. - -Definition hh: - forall (T : Type) (f1 : forall (T0 : Type), False -> filter1_rt1_type T0), - fwd - (Nat.leb - (size T - (fwd false (List T) - (fwd false (List T) - (proj1_sig - (hh_2 T - (f1 T (hh_1 T f1))))))) 0) bool - false = true. -Admitted. - -Set Program Mode. (* removing this line prevents the bug *) -Obligation Tactic := repeat t_base. - -Goal - forall T (h17: T), - filter1 T = - exist - _ - (Nil_construct T) - (hh T (fun (T : Type) (_ : False) => filter1 T)). -Abort. diff --git a/test-suite/bugs/closed/7811.v b/test-suite/bugs/closed/7811.v deleted file mode 100644 index fee330f22d..0000000000 --- a/test-suite/bugs/closed/7811.v +++ /dev/null @@ -1,114 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-emacs" "-top" "atomic" "-Q" "." "iris" "-R" "." "stdpp") -*- *) -(* File reduced by coq-bug-finder from original input, then from 140 lines to 26 lines, then from 141 lines to 27 lines, then from 142 lines to 27 lines, then from 272 lines to 61 lines, then from 291 lines to 94 lines, then from 678 lines to 142 lines, then from 418 lines to 161 lines, then from 538 lines to 189 lines, then from 840 lines to 493 lines, then from 751 lines to 567 lines, then from 913 lines to 649 lines, then from 875 lines to 666 lines, then from 784 lines to 568 lines, then from 655 lines to 173 lines, then from 317 lines to 94 lines, then from 172 lines to 86 lines, then from 102 lines to 86 lines, then from 130 lines to 86 lines, then from 332 lines to 112 lines, then from 279 lines to 111 lines, then from 3996 lines to 5697 lines, then from 153 lines to 117 lines, then from 146 lines to 108 lines, then from 124 lines to 108 lines *) -(* coqc version 8.8.0 (May 2018) compiled on May 2 2018 16:49:46 with OCaml 4.02.3 - coqtop version 8.8.0 (May 2018) *) - -(* This was triggering a "Not_found" at the time of printing/showing the goal *) - -Require Coq.Unicode.Utf8. - -Notation "t $ r" := (t r) - (at level 65, right associativity, only parsing). - -Inductive tele : Type := - | TeleO : tele - | TeleS {X} (binder : X -> tele) : tele. - -Fixpoint tele_fun (TT : tele) (T : Type) : Type := - match TT with - | TeleO => T - | TeleS b => forall x, tele_fun (b x) T - end. - -Inductive tele_arg : tele -> Type := -| TargO : tele_arg TeleO -| TargS {X} {binder} (x : X) : tele_arg (binder x) -> tele_arg (TeleS binder). - -Axiom tele_app : forall {TT : tele} {T} (f : tele_fun TT T), tele_arg TT -> T. - -Coercion tele_arg : tele >-> Sortclass. - -Inductive val := - | LitV - | PairV (v1 v2 : val) - | InjLV (v : val) - | InjRV (v : val). -Axiom coPset : Set. -Axiom atomic_update : forall {PROP : Type} {TA TB : tele}, coPset -> coPset -> (TA -> PROP) -> (TA -> TB -> PROP) -> (TA -> TB -> PROP) -> PROP. -Import Coq.Unicode.Utf8. -Notation "'AU' '<<' ∀ x1 .. xn , α '>>' @ Eo , Ei '<<' β , 'COMM' Φ '>>'" := - (atomic_update (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) - (TB:=TeleO) - Eo Ei - (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ - λ x1, .. (λ xn, α) ..) - (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ - λ x1, .. (λ xn, tele_app (TT:=TeleO) β) .. ) - (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ - λ x1, .. (λ xn, tele_app (TT:=TeleO) Φ) .. ) - ) - (at level 20, Eo, Ei, α, β, Φ at level 200, x1 binder, xn binder, - format "'[ ' 'AU' '<<' ∀ x1 .. xn , α '>>' '/' @ Eo , Ei '/' '[ ' '<<' β , '/' COMM Φ '>>' ']' ']'") : bi_scope. - -Axiom ident : Set. -Inductive env (A : Type) : Type := Enil : env A | Esnoc : env A → ident → A → env A. -Record envs (PROP : Type) : Type - := Envs { env_spatial : env PROP }. -Axiom positive : Set. -Axiom Qp : Set. -Axiom one : positive. -Goal forall (T : Type) (T0 : forall _ : T, Type) (P : Set) - (u : T) (γs : P) (Q : T0 u) (Φ o : forall _ : val, T0 u) - (stack_content0 : forall (_ : P) (_ : list val), T0 u) - (c c0 : coPset) (l : forall (A : Type) (_ : list A), list A) - (e0 : forall (_ : env (T0 u)) (_ : positive), envs (T0 u)) - (i0 : ident) (o1 : forall (_ : Qp) (_ : val), T0 u) - (b0 : forall _ : env (T0 u), T0 u) (P0 : forall _ : T0 u, Type) - (u0 : forall (_ : T0 u) (_ : T0 u), T0 u), - P0 - (@atomic_update (T0 u) - (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO))) TeleO c c0 - (@tele_app (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO))) - (T0 u) (fun (v : val) (q : Qp) => o1 q v)) - (@tele_app (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO))) - (forall _ : tele_arg TeleO, T0 u) - (fun (v : val) (q : Qp) => @tele_app TeleO (T0 u) (o1 q v))) - (@tele_app (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO))) - (forall _ : tele_arg TeleO, T0 u) - (fun (x : val) (_ : Qp) => - @tele_app TeleO (T0 u) - (u0 - (b0 - match - e0 - (@Esnoc (T0 u) (@Enil (T0 u)) i0 - (@atomic_update (T0 u) - (@TeleS (list val) (fun _ : list val => TeleO)) TeleO - c c0 - (@tele_app - (@TeleS (list val) (fun _ : list val => TeleO)) - (T0 u) (fun l0 : list val => stack_content0 γs l0)) - (@tele_app - (@TeleS (list val) (fun _ : list val => TeleO)) - (forall _ : tele_arg TeleO, T0 u) - (fun l0 : list val => - @tele_app TeleO (T0 u) - (stack_content0 γs (l val l0)))) - (@tele_app - (@TeleS (list val) (fun _ : list val => TeleO)) - (forall _ : tele_arg TeleO, T0 u) - (fun x1 : list val => - @tele_app TeleO (T0 u) - (u0 Q - (Φ - match x1 return val with - | nil => InjLV LitV - | cons v _ => InjRV v - end)))))) one - return (env (T0 u)) - with - | Envs _ env_spatial0 => env_spatial0 - end) (o x))))) -. - Show. -Abort. diff --git a/test-suite/bugs/closed/7854.v b/test-suite/bugs/closed/7854.v deleted file mode 100644 index ab1a29b632..0000000000 --- a/test-suite/bugs/closed/7854.v +++ /dev/null @@ -1,10 +0,0 @@ -Set Primitive Projections. - -CoInductive stream (A : Type) := cons { - hd : A; - tl : stream A; -}. - -CoFixpoint const {A} (x : A) := cons A x (const x). - -Check (@eq_refl _ (const tt) <<: tl unit (const tt) = const tt). diff --git a/test-suite/bugs/closed/7867.v b/test-suite/bugs/closed/7867.v deleted file mode 100644 index d0c7902756..0000000000 --- a/test-suite/bugs/closed/7867.v +++ /dev/null @@ -1,4 +0,0 @@ -(* Was a printer anomaly due to an internal lambda with no binders *) - -Class class := { foo : nat }. -Fail Instance : class := { foo := 0 ; bar := 0 }. diff --git a/test-suite/bugs/closed/7900.v b/test-suite/bugs/closed/7900.v deleted file mode 100644 index 583ef0ef3b..0000000000 --- a/test-suite/bugs/closed/7900.v +++ /dev/null @@ -1,53 +0,0 @@ -Require Import Coq.Program.Program. -(* Set Universe Polymorphism. *) -Set Printing Universes. - -Axiom ALL : forall {T:Prop}, T. - -Inductive Expr : Set := E (a : Expr). - -Parameter Value : Set. - -Fixpoint eval (e: Expr): Value := - match e with - | E a => eval a - end. - -Class Quote (n: Value) : Set := - { quote: Expr - ; eval_quote: eval quote = n }. - -Program Definition quote_mult n - `{!Quote n} : Quote n := - {| quote := E (quote (n:=n)) |}. - -Set Printing Universes. -Next Obligation. -Proof. - Show Universes. - destruct Quote0 as [q eq]. - Show Universes. - rewrite <- eq. - clear n eq. - Show Universes. - apply ALL. - Show Universes. -Qed. -Print quote_mult_obligation_1. -(* quote_mult_obligation_1@{} = -let Top_internal_eq_rew_dep := - fun (A : Type@{Coq.Init.Logic.8}) (x : A) (P : forall a : A, x = a -> Type@{Top.5} (* <- XXX *)) - (f : P x eq_refl) (y : A) (e : x = y) => - match e as e0 in (_ = y0) return (P y0 e0) with - | eq_refl => f - end in -fun (n : Value) (Quote0 : Quote n) => -match Quote0 as q return (eval quote = n) with -| {| quote := q; eval_quote := eq0 |} => - Top_internal_eq_rew_dep Value (eval q) (fun (n0 : Value) (eq1 : eval q = n0) => eval quote = n0) - ALL n eq0 -end - : forall (n : Value) (Quote0 : Quote n), eval (E quote) = n - -quote_mult_obligation_1 is universe polymorphic -*) diff --git a/test-suite/bugs/closed/7903.v b/test-suite/bugs/closed/7903.v deleted file mode 100644 index 55c7ee99a7..0000000000 --- a/test-suite/bugs/closed/7903.v +++ /dev/null @@ -1,4 +0,0 @@ -(* Slightly improving interpretation of Ltac subterms in notations *) - -Notation bar x f := (let z := ltac:(exact 1) in (fun x : nat => f)). -Check bar x (x + x). diff --git a/test-suite/bugs/closed/7967.v b/test-suite/bugs/closed/7967.v deleted file mode 100644 index 2c8855fd54..0000000000 --- a/test-suite/bugs/closed/7967.v +++ /dev/null @@ -1,2 +0,0 @@ -Set Universe Polymorphism. -Inductive A@{} : Set := B : ltac:(let y := constr:(Type) in exact nat) -> A. diff --git a/test-suite/bugs/closed/8004.v b/test-suite/bugs/closed/8004.v deleted file mode 100644 index 818639997a..0000000000 --- a/test-suite/bugs/closed/8004.v +++ /dev/null @@ -1,47 +0,0 @@ -Require Export Coq.Program.Tactics Coq.Classes.SetoidTactics Coq.Classes.CMorphisms . - -Set Universe Polymorphism. - -Delimit Scope category_theory_scope with category_theory. -Open Scope category_theory_scope. - -Infix "∧" := prod (at level 80, right associativity) : category_theory_scope. - -Class Setoid A := { - equiv : crelation A; - setoid_equiv :> Equivalence equiv -}. - -Notation "f ≈ g" := (equiv f g) (at level 79) : category_theory_scope. - -Open Scope list_scope. - -Generalizable All Variables. - -Fixpoint list_equiv `{Setoid A} (xs ys : list A) : Type := - match xs, ys with - | nil, nil => True - | x :: xs, y :: ys => x ≈ y ∧ list_equiv xs ys - | _, _ => False - end. - -Axiom proof_admitted : False. -Tactic Notation "admit" := abstract case proof_admitted. - -Program Instance list_equivalence `{Setoid A} : Equivalence list_equiv. -Next Obligation. - repeat intro. - induction x; simpl; split; auto. - reflexivity. -Qed. -Next Obligation. - repeat intro. - generalize dependent y. - induction x, y; simpl; intros; auto. - destruct X; split. - now symmetry. - intuition. -Qed. -Next Obligation. -admit. -Defined. diff --git a/test-suite/bugs/closed/8081.v b/test-suite/bugs/closed/8081.v deleted file mode 100644 index 0f2501aaa8..0000000000 --- a/test-suite/bugs/closed/8081.v +++ /dev/null @@ -1,4 +0,0 @@ -Section foo. -End foo. -Section foo. -End foo. diff --git a/test-suite/bugs/closed/808_2411.v b/test-suite/bugs/closed/808_2411.v deleted file mode 100644 index 1169b2036b..0000000000 --- a/test-suite/bugs/closed/808_2411.v +++ /dev/null @@ -1,27 +0,0 @@ -Section test. -Variable n:nat. -Lemma foo: 0 <= n. -Proof. -(* declaring an Axiom during a proof makes it immediatly - usable, juste as a full Definition. *) -Axiom bar : n = 1. -rewrite bar. -now apply le_S. -Qed. - -Lemma foo' : 0 <= n. -Proof. -(* Declaring an Hypothesis during a proof is ok, - but this hypothesis won't be usable by the current proof(s), - only by later ones. *) -Hypothesis bar' : n = 1. -Fail rewrite bar'. -Abort. - -Lemma foo'' : 0 <= n. -Proof. -rewrite bar'. -now apply le_S. -Qed. - -End test. diff --git a/test-suite/bugs/closed/8106.v b/test-suite/bugs/closed/8106.v deleted file mode 100644 index a711c5adef..0000000000 --- a/test-suite/bugs/closed/8106.v +++ /dev/null @@ -1,4 +0,0 @@ -(* Was raising an anomaly "already assigned a level" on the second line *) - -Notation "c1 ; c2" := (c1 + c2) (only printing, at level 76, right associativity, c1 at level 76, c2 at level 76). -Notation "c1 ; c2" := (c1 + c2) (only parsing, at level 76, right associativity, c2 at level 76). diff --git a/test-suite/bugs/closed/8119.v b/test-suite/bugs/closed/8119.v deleted file mode 100644 index c6329a7328..0000000000 --- a/test-suite/bugs/closed/8119.v +++ /dev/null @@ -1,46 +0,0 @@ -Require Import Coq.Strings.String. - -Section T. - Eval vm_compute in let x := tt in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) - Eval vm_compute in let _ := Set in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) - Eval vm_compute in let _ := Prop in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) -End T. - -Section U0. - Let n : unit := tt. - Eval vm_compute in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) - Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) -End U0. - -Section S0. - Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". - Eval vm_compute in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) - Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) -End S0. - -Class T := { }. -Section S1. - Context {p : T}. - Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". - Eval vm_compute in _. -(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) - Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. -(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) -End S1. - -Class M := { m : Type }. -Section S2. - Context {p : M}. - Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". - Eval vm_compute in _. -(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) - Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. -(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) -End S2. diff --git a/test-suite/bugs/closed/8121.v b/test-suite/bugs/closed/8121.v deleted file mode 100644 index 99267612ca..0000000000 --- a/test-suite/bugs/closed/8121.v +++ /dev/null @@ -1,46 +0,0 @@ -Require Import Coq.Strings.String. - -Section T. - Eval native_compute in let x := tt in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) - Eval native_compute in let _ := Set in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) - Eval native_compute in let _ := Prop in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) -End T. - -Section U0. - Let n : unit := tt. - Eval native_compute in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) - Goal exists tt : unit, tt = tt. eexists. native_compute. Abort. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) -End U0. - -Section S0. - Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". - Eval native_compute in _. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) - Goal exists tt : unit, tt = tt. eexists. native_compute. Abort. -(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) -End S0. - -Class T := { }. -Section S1. - Context {p : T}. - Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". - Eval native_compute in _. -(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) - Goal exists tt : unit, tt = tt. eexists. native_compute. Abort. -(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) -End S1. - -Class M := { m : Type }. -Section S2. - Context {p : M}. - Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". - Eval native_compute in _. -(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) - Goal exists tt : unit, tt = tt. eexists. native_compute. Abort. -(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) -End S2. diff --git a/test-suite/bugs/closed/8126.v b/test-suite/bugs/closed/8126.v deleted file mode 100644 index f52dfc6b47..0000000000 --- a/test-suite/bugs/closed/8126.v +++ /dev/null @@ -1,13 +0,0 @@ -(* See also output test Notations4.v *) - -Inductive foo := tt. -Bind Scope foo_scope with foo. -Delimit Scope foo_scope with foo. -Notation "'HI'" := tt : foo_scope. -Definition myfoo (x : nat) (y : nat) (z : foo) := y. -Notation myfoo0 := (@myfoo 0). -Notation myfoo01 := (@myfoo0 1). -Check myfoo 0 1 HI. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) -Check myfoo0 1 HI. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) -Check myfoo01 tt. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) -Check myfoo01 HI. (* was failing *) diff --git a/test-suite/bugs/closed/8215.v b/test-suite/bugs/closed/8215.v deleted file mode 100644 index c4b29a6354..0000000000 --- a/test-suite/bugs/closed/8215.v +++ /dev/null @@ -1,14 +0,0 @@ -(* Check that instances for local definitions in evars have compatible body *) -Goal False. -Proof. - pose (n := 1). - evar (m:nat). - subst n. - pose (n := 0). - Fail Check ?m. (* n cannot be reinterpreted with a value convertible to 1 *) - clearbody n. - Fail Check ?m. (* n cannot be reinterpreted with a value convertible to 1 *) - clear n. - pose (n := 0+1). - Check ?m. (* Should be ok *) -Abort. diff --git a/test-suite/bugs/closed/8270.v b/test-suite/bugs/closed/8270.v deleted file mode 100644 index f36f757f10..0000000000 --- a/test-suite/bugs/closed/8270.v +++ /dev/null @@ -1,15 +0,0 @@ -(* Don't do zeta in cbn when not asked for *) - -Goal let x := 0 in - let y := x in - y = 0. - (* We use "cofix" as an example because there are obviously no - cofixpoints in sight. This problem arises with any set of - reduction flags (not including zeta where the lets are of course reduced away) *) - cbn cofix. - intro x. - unfold x at 1. (* Should succeed *) - Undo 2. - cbn zeta. - Fail unfold x at 1. -Abort. diff --git a/test-suite/bugs/closed/8288.v b/test-suite/bugs/closed/8288.v deleted file mode 100644 index 0350be9c06..0000000000 --- a/test-suite/bugs/closed/8288.v +++ /dev/null @@ -1,7 +0,0 @@ -Set Universe Polymorphism. -Set Printing Universes. - -Set Polymorphic Inductive Cumulativity. - -Inductive foo := C : (forall A : Type -> Type, A Type) -> foo. -(* anomaly invalid subtyping relation *) diff --git a/test-suite/bugs/closed/8432.v b/test-suite/bugs/closed/8432.v deleted file mode 100644 index 844ee12668..0000000000 --- a/test-suite/bugs/closed/8432.v +++ /dev/null @@ -1,39 +0,0 @@ -Require Import Program.Tactics. - -Obligation Tactic := idtac. -Set Universe Polymorphism. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Inductive Empty : Type :=. -Inductive Unit : Type := tt. -Definition not (A : Type) := A -> Empty. - - Lemma nat_path_O_S (n : nat) (H : paths O (S n)) : Empty. - Proof. refine ( - match H in paths _ i return - match i with - | O => Unit - | S _ => Empty - end - with - | idpath _ => tt - end - ). Defined. - Lemma symmetry {A} (x y : A) (p : paths x y) : paths y x. - Proof. - destruct p. apply idpath. - Defined. - Lemma nat_path_S_O (n : nat) (H : paths (S n) O) : Empty. - Proof. eapply nat_path_O_S. exact (symmetry _ _ H). Defined. -Set Printing Universes. -Program Fixpoint succ_not_zero (n:nat) : not (paths (S n) 0) := -match n as n return not (paths (S n) 0) with -| 0 => nat_path_S_O _ -| S n' => let dummy := succ_not_zero n' in _ -end. -Next Obligation. - intros f _ n dummy H. exact (nat_path_S_O _ H). - Show Universes. -Defined. diff --git a/test-suite/bugs/closed/8478.v b/test-suite/bugs/closed/8478.v deleted file mode 100644 index 8baaf8686a..0000000000 --- a/test-suite/bugs/closed/8478.v +++ /dev/null @@ -1,11 +0,0 @@ -Set Universe Polymorphism. -Set Printing Universes. -Unset Strict Universe Declaration. - -Monomorphic Universe v. - -Section Foo. - Let bar := Type@{u}. - Fail Monomorphic Constraint bar.u < v. - -End Foo. (* was anomaly undeclared universe due to the constraint *) diff --git a/test-suite/bugs/closed/8532.v b/test-suite/bugs/closed/8532.v deleted file mode 100644 index 00aa66e701..0000000000 --- a/test-suite/bugs/closed/8532.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Checking Print Assumptions relatively to a bound module *) - -Module Type Typ. - Parameter Inline(10) t : Type. -End Typ. -Module Terms_mod (SetVars : Typ). -Print Assumptions SetVars.t. -End Terms_mod. diff --git a/test-suite/bugs/closed/bug_1238.v b/test-suite/bugs/closed/bug_1238.v new file mode 100644 index 0000000000..6b6e83779f --- /dev/null +++ b/test-suite/bugs/closed/bug_1238.v @@ -0,0 +1,22 @@ +Require Import Setoid. + +Variable A : Set. + +Inductive liste : Set := +| vide : liste +| c : A -> liste -> liste. + +Inductive e : A -> liste -> Prop := +| ec : forall (x : A) (l : liste), e x (c x l) +| ee : forall (x y : A) (l : liste), e x l -> e x (c y l). + +Definition same := fun (l m : liste) => forall (x : A), e x l <-> e x m. + +Definition same_refl (x:liste) : (same x x). + unfold same; split; intros; trivial. +Qed. + +Goal forall (x:liste), (same x x). + intro. + apply (same_refl x). +Qed. diff --git a/test-suite/bugs/closed/bug_1243.v b/test-suite/bugs/closed/bug_1243.v new file mode 100644 index 0000000000..a80e1dd609 --- /dev/null +++ b/test-suite/bugs/closed/bug_1243.v @@ -0,0 +1,9 @@ +Require Import ZArith. +Require Import Arith. +Open Scope Z_scope. + +Theorem r_ex : (forall x y:nat, x + y = x + y)%nat. +Admitted. + +Theorem r_ex' : forall x y:nat, (x + y = x + y)%nat. +Admitted. diff --git a/test-suite/bugs/closed/bug_1302.v b/test-suite/bugs/closed/bug_1302.v new file mode 100644 index 0000000000..bea71f5022 --- /dev/null +++ b/test-suite/bugs/closed/bug_1302.v @@ -0,0 +1,21 @@ +Module Type T. + +Parameter A : Type. + +Inductive L : Type := +| L0 : L (* without this constructor, it works right *) +| L1 : A -> L. + +End T. + +Axiom Tp : Type. + +Module TT : T. + +Definition A : Type := Tp. + +Inductive L : Type := +| L0 : L +| L1 : A -> L. + +End TT. diff --git a/test-suite/bugs/closed/bug_1322.v b/test-suite/bugs/closed/bug_1322.v new file mode 100644 index 0000000000..6941ade44c --- /dev/null +++ b/test-suite/bugs/closed/bug_1322.v @@ -0,0 +1,28 @@ +Require Import Setoid. + +Section transition_gen. + +Variable I : Type. +Variable I_eq :I -> I -> Prop. +Variable I_eq_equiv : Setoid_Theory I I_eq. + +(* Add Relation I I_eq + reflexivity proved by I_eq_equiv.(Seq_refl I I_eq) + symmetry proved by I_eq_equiv.(Seq_sym I I_eq) + transitivity proved by I_eq_equiv.(Seq_trans I I_eq) +as I_eq_relation. *) + +Add Parametric Relation : I I_eq + reflexivity proved by I_eq_equiv.(@Equivalence_Reflexive _ _) + symmetry proved by I_eq_equiv.(@Equivalence_Symmetric _ _) + transitivity proved by I_eq_equiv.(@Equivalence_Transitive _ _) + as I_with_eq. + +Variable F : I -> Type. +Variable F_morphism : forall i j, I_eq i j -> F i = F j. + + +Add Morphism F with signature I_eq ==> (@eq _) as F_morphism2. +Admitted. + +End transition_gen. diff --git a/test-suite/bugs/closed/bug_1341.v b/test-suite/bugs/closed/bug_1341.v new file mode 100644 index 0000000000..79a0a14d7c --- /dev/null +++ b/test-suite/bugs/closed/bug_1341.v @@ -0,0 +1,17 @@ +Require Import Setoid. + +Section Setoid_Bug. + +Variable X:Type -> Type. +Variable Xeq : forall A, (X A) -> (X A) -> Prop. +Hypothesis Xst : forall A, Equivalence (Xeq A). + +Variable map : forall A B, (A -> B) -> X A -> X B. + +Arguments map [A B]. + +Goal forall A B (a b:X (B -> A)) (c:X A) (f:A -> B -> A), Xeq _ a b -> Xeq _ b (map f c) -> Xeq _ a (map f c). +intros A B a b c f Hab Hbc. +rewrite Hab. +assumption. +Qed. diff --git a/test-suite/bugs/closed/bug_1362.v b/test-suite/bugs/closed/bug_1362.v new file mode 100644 index 0000000000..6cafb9f0cd --- /dev/null +++ b/test-suite/bugs/closed/bug_1362.v @@ -0,0 +1,26 @@ +(** Omega is now aware of the bodies of context variables + (of type Z or nat). *) + +Require Import ZArith Omega. +Open Scope Z. + +Goal let x := 3 in x = 3. +intros. +omega. +Qed. + +Open Scope nat. + +Goal let x := 2 in x = 2. +intros. +omega. +Qed. + +(** NB: this could be disabled for compatibility reasons *) + +Unset Omega UseLocalDefs. + +Goal let x := 4 in x = 4. +intros. +Fail omega. +Abort. diff --git a/test-suite/bugs/closed/bug_1411.v b/test-suite/bugs/closed/bug_1411.v new file mode 100644 index 0000000000..504c967a20 --- /dev/null +++ b/test-suite/bugs/closed/bug_1411.v @@ -0,0 +1,34 @@ +Require Import List. +Require Import Program. + +Inductive Tree : Set := +| Br : Tree -> Tree -> Tree +| No : nat -> Tree +. + +(* given a tree, we want to know which lists can + be used to navigate exactly to a node *) +Inductive Exact : Tree -> list bool -> Prop := +| exDone n : Exact (No n) nil +| exLeft l r p: Exact l p -> Exact (Br l r) (true::p) +| exRight l r p: Exact r p -> Exact (Br l r) (false::p) +. + +Definition unreachable A : False -> A. +intros. +destruct H. +Defined. + +Program Fixpoint fetch t p (x:Exact t p) {struct t} := + match t, p with + | No p' , nil => p' + | No p' , _::_ => unreachable nat _ + | Br l r, nil => unreachable nat _ + | Br l r, true::t => fetch l t _ + | Br l r, false::t => fetch r t _ + end. + +Next Obligation. inversion x. Qed. +Next Obligation. inversion x. Qed. +Next Obligation. inversion x; trivial. Qed. +Next Obligation. inversion x; trivial. Qed. diff --git a/test-suite/bugs/closed/bug_1414.v b/test-suite/bugs/closed/bug_1414.v new file mode 100644 index 0000000000..ee9e2504a6 --- /dev/null +++ b/test-suite/bugs/closed/bug_1414.v @@ -0,0 +1,40 @@ +Require Import ZArith Coq.Program.Wf Coq.Program.Utils. + +Parameter data:Set. + +Inductive t : Set := + | Leaf : t + | Node : t -> data -> t -> Z -> t. + +Parameter avl : t -> Prop. +Parameter bst : t -> Prop. +Parameter In : data -> t -> Prop. +Parameter cardinal : t -> nat. +Definition card2 (s:t*t) := let (s1,s2) := s in cardinal s1 + cardinal s2. + +Parameter split : data -> t -> t*(bool*t). +Parameter join : t -> data -> t -> t. +Parameter add : data -> t -> t. + +Program Fixpoint union + (s u:t) + (hb1: bst s)(ha1: avl s)(hb2: bst u)(hb2: avl u) + { measure (cardinal s + cardinal u) } : + {s' : t | bst s' /\ avl s' /\ forall x, In x s' <-> In x s \/ In x u} := + match s, u with + | Leaf,t2 => t2 + | t1,Leaf => t1 + | Node l1 v1 r1 h1, Node l2 v2 r2 h2 => + if (Z_ge_lt_dec h1 h2) then + if (Z.eq_dec h2 1) + then add v2 s + else + let (l2', r2') := split v1 u in + join (union l1 l2' _ _ _ _) v1 (union r1 (snd r2') _ _ _ _) + else + if (Z.eq_dec h1 1) + then add v1 s + else + let (l1', r1') := split v2 u in + join (union l1' l2 _ _ _ _) v2 (union (snd r1') r2 _ _ _ _) + end. diff --git a/test-suite/bugs/closed/bug_1416.v b/test-suite/bugs/closed/bug_1416.v new file mode 100644 index 0000000000..667c6b1d5f --- /dev/null +++ b/test-suite/bugs/closed/bug_1416.v @@ -0,0 +1,29 @@ +(* In 8.1 autorewrite used to raised an anomaly here *) +(* After resolution of the bug, autorewrite succeeded *) +(* From forthcoming 8.4, autorewrite is forbidden to instantiate *) +(* evars, so the new test just checks it is not an anomaly *) + +Set Implicit Arguments. + +Record Place (Env A: Type) : Type := { + read: Env -> A ; + write: Env -> A -> Env ; + write_read: forall (e:Env), (write e (read e))=e +}. + +Hint Rewrite -> write_read: placeeq. + +Record sumPl (Env A B: Type) (vL:(Place Env A)) (vR:(Place Env B)) : Type := + { + mkEnv: A -> B -> Env ; + mkEnv2writeL: forall (e:Env) (x:A), (mkEnv x (read vR e))=(write vL e x) + }. + +(* when the following line is commented, the bug does not appear *) +Hint Rewrite -> mkEnv2writeL: placeeq. + +Lemma autorewrite_raise_anomaly: forall (Env A:Type) (e: Env) (p:Place Env A), + (exists e1:Env, e=(write p e1 (read p e))). +Proof. + intros Env A e p; eapply ex_intro. + autorewrite with placeeq. (* Here is the bug *) diff --git a/test-suite/bugs/closed/bug_1419.v b/test-suite/bugs/closed/bug_1419.v new file mode 100644 index 0000000000..d021107d1d --- /dev/null +++ b/test-suite/bugs/closed/bug_1419.v @@ -0,0 +1,8 @@ +Goal True. + set(a := 0). + set(b := a). + unfold a in b. + clear a. + Eval vm_compute in b. + trivial. +Qed. diff --git a/test-suite/bugs/closed/bug_1425.v b/test-suite/bugs/closed/bug_1425.v new file mode 100644 index 0000000000..775d278e74 --- /dev/null +++ b/test-suite/bugs/closed/bug_1425.v @@ -0,0 +1,19 @@ +Require Import Setoid. + +Parameter recursion : forall A : Set, A -> (nat -> A -> A) -> nat -> A. + +Axiom recursion_S : + forall (A : Set) (EA : relation A) (a : A) (f : nat -> A -> A) (n : nat), + EA (recursion A a f (S n)) (f n (recursion A a f n)). + +Goal forall n : nat, recursion nat 0 (fun _ _ => 1) (S n) = 1. +intro n. +rewrite recursion_S. +reflexivity. +Qed. + +Goal forall n : nat, recursion nat 0 (fun _ _ => 1) (S n) = 1. +intro n. +setoid_rewrite recursion_S. +reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_1446.v b/test-suite/bugs/closed/bug_1446.v new file mode 100644 index 0000000000..8cb2d653b6 --- /dev/null +++ b/test-suite/bugs/closed/bug_1446.v @@ -0,0 +1,20 @@ +Lemma not_true_eq_false : forall (b:bool), b <> true -> b = false. +Proof. + destruct b;intros;trivial. + elim H. + exact (refl_equal true). +Qed. + +Section BUG. + + Variable b : bool. + Hypothesis H : b <> true. + Hypothesis H0 : b = true. + Hypothesis H1 : b <> true. + + Goal False. + rewrite (not_true_eq_false _ H) in * |-. + contradiction. + Qed. + +End BUG. diff --git a/test-suite/bugs/closed/bug_1448.v b/test-suite/bugs/closed/bug_1448.v new file mode 100644 index 0000000000..fe3b4c8b41 --- /dev/null +++ b/test-suite/bugs/closed/bug_1448.v @@ -0,0 +1,28 @@ +Require Import Relations. +Require Import Setoid. +Require Import Ring_theory. +Require Import Ring_base. + + +Variable R : Type. +Variable Rone Rzero : R. +Variable Rplus Rmult Rminus : R -> R -> R. +Variable Rneg : R -> R. + +Lemma my_ring_theory : @ring_theory R Rzero Rone Rplus Rmult Rminus Rneg (@eq +R). +Admitted. + +Variable Req : R -> R -> Prop. + +Hypothesis Req_refl : reflexive _ Req. +Hypothesis Req_sym : symmetric _ Req. +Hypothesis Req_trans : transitive _ Req. + +Add Relation R Req + reflexivity proved by Req_refl + symmetry proved by Req_sym + transitivity proved by Req_trans + as Req_rel. + +Add Ring my_ring : my_ring_theory (abstract). diff --git a/test-suite/bugs/closed/bug_1477.v b/test-suite/bugs/closed/bug_1477.v new file mode 100644 index 0000000000..dfc8c32806 --- /dev/null +++ b/test-suite/bugs/closed/bug_1477.v @@ -0,0 +1,18 @@ +Inductive I : Set := + | A : nat -> nat -> I + | B : nat -> nat -> I. + +Definition foo1 (x:I) : nat := + match x with + | A a b | B a b => S b + end. + +Definition foo2 (x:I) : nat := + match x with + | A _ b | B b _ => S b + end. + +Definition foo (x:I) : nat := + match x with + | A a b | B b a => S b + end. diff --git a/test-suite/bugs/closed/bug_1483.v b/test-suite/bugs/closed/bug_1483.v new file mode 100644 index 0000000000..0d1419b94d --- /dev/null +++ b/test-suite/bugs/closed/bug_1483.v @@ -0,0 +1,7 @@ +Require Import BinPos. + +Definition P := (fun x : positive => x = xH). + +Goal forall (p q : positive), P q -> q = p -> P p. +intros; congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_1501.v b/test-suite/bugs/closed/bug_1501.v new file mode 100644 index 0000000000..e771e192dc --- /dev/null +++ b/test-suite/bugs/closed/bug_1501.v @@ -0,0 +1,67 @@ +Set Implicit Arguments. + + +Require Export Relation_Definitions. +Require Export Setoid. +Require Import Morphisms. + + +Section Essais. + +(* Parametrized Setoid *) +Parameter K : Type -> Type. +Parameter equiv : forall A : Type, K A -> K A -> Prop. +Parameter equiv_refl : forall (A : Type) (x : K A), equiv x x. +Parameter equiv_sym : forall (A : Type) (x y : K A), equiv x y -> equiv y x. +Parameter equiv_trans : forall (A : Type) (x y z : K A), equiv x y -> equiv y z +-> equiv x z. + +(* basic operations *) +Parameter val : forall A : Type, A -> K A. +Parameter bind : forall A B : Type, K A -> (A -> K B) -> K B. + +Parameter + bind_compat : + forall (A B : Type) (m1 m2 : K A) (f1 f2 : A -> K B), + equiv m1 m2 -> + (forall x : A, equiv (f1 x) (f2 x)) -> equiv (bind m1 f1) (bind m2 f2). + +(* monad axioms *) +Parameter + bind_val_l : + forall (A B : Type) (a : A) (f : A -> K B), equiv (bind (val a) f) (f a). +Parameter + bind_val_r : + forall (A : Type) (m : K A), equiv (bind m (fun a => val a)) m. +Parameter + bind_assoc : + forall (A B C : Type) (m : K A) (f : A -> K B) (g : B -> K C), + equiv (bind (bind m f) g) (bind m (fun a => bind (f a) g)). + + +Hint Resolve equiv_refl equiv_sym equiv_trans: monad. + +Add Parametric Relation A : (K A) (@equiv A) + reflexivity proved by (@equiv_refl A) + symmetry proved by (@equiv_sym A) + transitivity proved by (@equiv_trans A) + as equiv_rel. + +Add Parametric Morphism A B : (@bind A B) + with signature (@equiv A) ==> (pointwise_relation A (@equiv B)) ==> (@equiv B) + as bind_mor. +Proof. + unfold pointwise_relation; intros; apply bind_compat; auto. +Qed. + +Lemma test: + forall (A B: Type) (m1 m2 m3: K A) (f: A -> A -> K B), + (equiv m1 m2) -> (equiv m2 m3) -> + equiv (bind m1 (fun a => bind m2 (fun a' => f a a'))) + (bind m2 (fun a => bind m3 (fun a' => f a a'))). +Proof. + intros A B m1 m2 m3 f H1 H2. + setoid_rewrite H1. (* this works *) + setoid_rewrite H2. + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_1507.v b/test-suite/bugs/closed/bug_1507.v new file mode 100644 index 0000000000..96e421de64 --- /dev/null +++ b/test-suite/bugs/closed/bug_1507.v @@ -0,0 +1,119 @@ +(* + Implementing reals a la Stolzenberg + + Danko Ilik, March 2007 + + XField.v -- (unfinished) axiomatisation of the theories of real and + rational intervals. +*) + +Definition associative (A:Type)(op:A->A->A) := + forall x y z:A, op (op x y) z = op x (op y z). + +Definition commutative (A:Type)(op:A->A->A) := + forall x y:A, op x y = op y x. + +Definition trichotomous (A:Type)(R:A->A->Prop) := + forall x y:A, R x y \/ x=y \/ R y x. + +Definition relation (A:Type) := A -> A -> Prop. +Definition reflexive (A:Type)(R:relation A) := forall x:A, R x x. +Definition transitive (A:Type)(R:relation A) := + forall x y z:A, R x y -> R y z -> R x z. +Definition symmetric (A:Type)(R:relation A) := forall x y:A, R x y -> R y x. + +Record interval (X:Set)(le:X->X->Prop) : Set := + interval_make { + interval_left : X; + interval_right : X; + interval_nonempty : le interval_left interval_right + }. + +Record I (grnd:Set)(le:grnd->grnd->Prop) : Type := Imake { + Icar := interval grnd le; + Iplus : Icar -> Icar -> Icar; + Imult : Icar -> Icar -> Icar; + Izero : Icar; + Ione : Icar; + Iopp : Icar -> Icar; + Iinv : Icar -> Icar; + Ic : Icar -> Icar -> Prop; (* consistency *) + (* monoids *) + Iplus_assoc : associative Icar Iplus; + Imult_assoc : associative Icar Imult; + (* abelian groups *) + Iplus_comm : commutative Icar Iplus; + Imult_comm : commutative Icar Imult; + Iplus_0_l : forall x:Icar, Ic (Iplus Izero x) x; + Iplus_0_r : forall x:Icar, Ic (Iplus x Izero) x; + Imult_0_l : forall x:Icar, Ic (Imult Ione x) x; + Imult_0_r : forall x:Icar, Ic (Imult x Ione) x; + Iplus_opp_r : forall x:Icar, Ic (Iplus x (Iopp x)) (Izero); + Imult_inv_r : forall x:Icar, ~(Ic x Izero) -> Ic (Imult x (Iinv x)) Ione; + (* distributive laws *) + Imult_plus_distr_l : forall x x' y y' z z' z'', + Ic x x' -> Ic y y' -> Ic z z' -> Ic z z'' -> + Ic (Imult (Iplus x y) z) (Iplus (Imult x' z') (Imult y' z'')); + (* order and lattice structure *) + Ilt : Icar -> Icar -> Prop; + Ilc := fun (x y:Icar) => Ilt x y \/ Ic x y; + Isup : Icar -> Icar -> Icar; + Iinf : Icar -> Icar -> Icar; + Ilt_trans : transitive _ lt; + Ilt_trich : forall x y:Icar, Ilt x y \/ Ic x y \/ Ilt y x; + Isup_lub : forall x y z:Icar, Ilc x z -> Ilc y z -> Ilc (Isup x y) z; + Iinf_glb : forall x y z:Icar, Ilc x y -> Ilc x z -> Ilc x (Iinf y z); + (* order preserves operations? *) + (* properties of Ic *) + Ic_refl : reflexive _ Ic; + Ic_sym : symmetric _ Ic +}. + +Definition interval_set (X:Set)(le:X->X->Prop) := + (interval X le) -> Prop. (* can be Set as well *) +Check interval_set. +Check Ic. +Definition consistent (X:Set)(le:X->X->Prop)(TI:I X le)(p:interval_set X le) := + forall I J:interval X le, p I -> p J -> (Ic X le TI) I J. +Check consistent. +(* define 'fine' *) + +Record N (grnd:Set)(le:grnd->grnd->Prop)(grndI:I grnd le) : Type := Nmake { + Ncar := interval_set grnd le; + Nplus : Ncar -> Ncar -> Ncar; + Nmult : Ncar -> Ncar -> Ncar; + Nzero : Ncar; + None : Ncar; + Nopp : Ncar -> Ncar; + Ninv : Ncar -> Ncar; + Nc : Ncar -> Ncar -> Prop; (* Ncistency *) + (* monoids *) + Nplus_assoc : associative Ncar Nplus; + Nmult_assoc : associative Ncar Nmult; + (* abelian groups *) + Nplus_comm : commutative Ncar Nplus; + Nmult_comm : commutative Ncar Nmult; + Nplus_0_l : forall x:Ncar, Nc (Nplus Nzero x) x; + Nplus_0_r : forall x:Ncar, Nc (Nplus x Nzero) x; + Nmult_0_l : forall x:Ncar, Nc (Nmult None x) x; + Nmult_0_r : forall x:Ncar, Nc (Nmult x None) x; + Nplus_opp_r : forall x:Ncar, Nc (Nplus x (Nopp x)) (Nzero); + Nmult_inv_r : forall x:Ncar, ~(Nc x Nzero) -> Nc (Nmult x (Ninv x)) None; + (* distributive laws *) + Nmult_plus_distr_l : forall x x' y y' z z' z'', + Nc x x' -> Nc y y' -> Nc z z' -> Nc z z'' -> + Nc (Nmult (Nplus x y) z) (Nplus (Nmult x' z') (Nmult y' z'')); + (* order and lattice structure *) + Nlt : Ncar -> Ncar -> Prop; + Nlc := fun (x y:Ncar) => Nlt x y \/ Nc x y; + Nsup : Ncar -> Ncar -> Ncar; + Ninf : Ncar -> Ncar -> Ncar; + Nlt_trans : transitive _ lt; + Nlt_trich : forall x y:Ncar, Nlt x y \/ Nc x y \/ Nlt y x; + Nsup_lub : forall x y z:Ncar, Nlc x z -> Nlc y z -> Nlc (Nsup x y) z; + Ninf_glb : forall x y z:Ncar, Nlc x y -> Nlc x z -> Nlc x (Ninf y z); + (* order preserves operations? *) + (* properties of Nc *) + Nc_refl : reflexive _ Nc; + Nc_sym : symmetric _ Nc +}. diff --git a/test-suite/bugs/closed/bug_1519.v b/test-suite/bugs/closed/bug_1519.v new file mode 100644 index 0000000000..de60de59e9 --- /dev/null +++ b/test-suite/bugs/closed/bug_1519.v @@ -0,0 +1,23 @@ +Section S. + + Variable A:Prop. + Variable W:A. + + Remark T: A -> A. + intro Z. + rename W into Z_. + rename Z into W. + rename Z_ into Z. + exact Z. + Qed. + + (* bug : + Error: + Unbound reference: In environment + A : Prop + W : A + Z : A + The reference 2 is free + *) + +End S. diff --git a/test-suite/bugs/closed/bug_1542.v b/test-suite/bugs/closed/bug_1542.v new file mode 100644 index 0000000000..52cfbbc496 --- /dev/null +++ b/test-suite/bugs/closed/bug_1542.v @@ -0,0 +1,40 @@ +Module Type TITI. +Parameter B:Set. +Parameter x:B. +Inductive A:Set:= +a1:B->A. +Definition f2: A ->B +:= fun (a:A) => +match a with + (a1 b)=>b +end. +Definition f: A -> B:=fun (a:A) => x. +End TITI. + + +Module Type TIT. +Declare Module t:TITI. +End TIT. + +Module Seq(titi:TIT). +Module t:=titi.t. +Inductive toto:t.A->t.B->Set:= +t1:forall (a:t.A), (toto a (t.f a)) +| t2:forall (a:t.A), (toto a (t.f2 a)). +End Seq. + +Module koko(tit:TIT). +Module seq:=Seq tit. +Module t':=tit.t. + +Definition def:forall (a:t'.A), (seq.toto a (t'.f a)). +intro ; constructor 1. +Defined. + +Definition def2: forall (a:t'.A), (seq.toto a (t'.f2 a)). +intro; constructor 2. +(* Toplevel input, characters 0-13 + constructor 2. + ^^^^^^^^^^^^^ +Error: Impossible to unify (seq.toto ?3 (seq.t.f2 ?3)) with + (seq.toto a (t'.f2 a)).*) diff --git a/test-suite/bugs/closed/bug_1543.v b/test-suite/bugs/closed/bug_1543.v new file mode 100644 index 0000000000..def6ed98dd --- /dev/null +++ b/test-suite/bugs/closed/bug_1543.v @@ -0,0 +1,100 @@ +Module Sylvain_Boulme. +Module Type Essai. +Parameter T: Type. +Parameter my_eq: T -> T -> Prop. +Parameter my_eq_refl: forall (x:T), (my_eq x x). +Parameter c: T. +End Essai. + +Module Type Essai2. +Declare Module M: Essai. +Parameter c2: M.T. +End Essai2. + +Module Type Essai3. +Declare Module M: Essai. +Parameter c3: M.T. +End Essai3. + +Module Type Lift. +Declare Module Core: Essai. +Declare Module M: Essai. +Parameter lift: Core.T -> M.T. +Parameter lift_prop:forall (x:Core.T), (Core.my_eq x Core.c)->(M.my_eq (lift x) M.c). +End Lift. + +Module I2 (X:Essai) <: Essai2. + Module Core := X. + Module M<:Essai. + Definition T:Type :=Prop. + Definition my_eq:=(@eq Prop). + Definition c:=True. + Lemma my_eq_refl: forall (x:T), (my_eq x x). + Proof. + unfold my_eq; auto. + Qed. + End M. + Definition c2:=False. + Definition lift:=fun (_:Core.T) => M.c. + Definition lift_prop: forall (x:Core.T), (Core.my_eq x Core.c)->(M.my_eq (lift x) M.c). + Proof. + unfold lift, M.my_eq; auto. + Qed. +End I2. + +Module I4(X:Essai3) (L: Lift with Module Core := X.M) <: Essai3 with Module +M:=L.M. + Module M:=L.M. + Definition c3:=(L.lift X.c3). +End I4. + +Module I5(X:Essai3). + Module Toto<: Lift with Module Core := X.M := I2(X.M). + Module E4<: Essai3 with Module M:=Toto.M := I4(X)(Toto). +(* +Le typage de E4 echoue avec le message + Error: Signature components for label my_eq_refl do not match + *) + + Module E3<: Essai3 := I4(X)(Toto). + + Definition zarb: forall (x:Toto.M.T), (Toto.M.my_eq x x) := E3.M.my_eq_refl. +End I5. +End Sylvain_Boulme. + + +Module Jacek. + + Module Type SIG. + End SIG. + Module N. + Definition A:=Set. + End N. + Module Type SIG2. + Declare Module M:SIG. + Parameter B:Type. + End SIG2. + Module F(X:SIG2 with Module M:=N) (Y:SIG2 with Definition B:=X.M.A). + End F. +End Jacek. + + +Module anoun. + Module Type TITI. + Parameter X: Set. + End TITI. + + Module Type Ex. + Declare Module t: TITI. + Parameter X : t.X -> t.X -> Set. + End Ex. + + Module unionEx(X1: Ex) (X2:Ex with Module t :=X1.t): Ex. + Module t:=X1.t. + Definition X :=fun (a b:t.X) => ((X1.X a b)+(X2.X a b))%type. + End unionEx. +End anoun. +(* Le warning qui s'affiche lors de la compilation est le suivant : + TODO:replace module after with! + Est ce qu'il y'a qq1 qui pourrait m'aider à comprendre le probleme?! + Je vous remercie d'avance *) diff --git a/test-suite/bugs/closed/bug_1545.v b/test-suite/bugs/closed/bug_1545.v new file mode 100644 index 0000000000..9ef796faf7 --- /dev/null +++ b/test-suite/bugs/closed/bug_1545.v @@ -0,0 +1,20 @@ +Module Type TIT. + +Inductive X:Set:= + b:X. +End TIT. + + +Module Type TOTO. +Declare Module t:TIT. +Inductive titi:Set:= + a:t.X->titi. +End TOTO. + + +Module toto (ta:TOTO). +Module ti:=ta.t. + +Definition ex1:forall (c d:ti.X), (ta.a d)=(ta.a c) -> d=c. +intros. +injection H. diff --git a/test-suite/bugs/closed/bug_1547.v b/test-suite/bugs/closed/bug_1547.v new file mode 100644 index 0000000000..166fa7a9f2 --- /dev/null +++ b/test-suite/bugs/closed/bug_1547.v @@ -0,0 +1,5 @@ +(* Compatibility of Require with backtracking at interactive module end *) + +Module A. +Require List. +End A. diff --git a/test-suite/bugs/closed/bug_1551.v b/test-suite/bugs/closed/bug_1551.v new file mode 100644 index 0000000000..48f0b55129 --- /dev/null +++ b/test-suite/bugs/closed/bug_1551.v @@ -0,0 +1,13 @@ +Module Type S. + Parameter empty: Set. +End S. + +Module D (M:S). + Import M. + Definition empty:=nat. +End D. + +Module D' (M:S). + Import M. + Definition empty:Set. exact nat. Qed. +End D'. diff --git a/test-suite/bugs/closed/bug_1568.v b/test-suite/bugs/closed/bug_1568.v new file mode 100644 index 0000000000..25fdcd297f --- /dev/null +++ b/test-suite/bugs/closed/bug_1568.v @@ -0,0 +1,11 @@ +CoInductive A: Set := + mk_A: B -> A +with B: Set := + mk_B: A -> B. + +CoFixpoint a:A := mk_A b +with b:B := mk_B a. + +Goal b = match a with mk_A a1 => a1 end. + simpl. reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_1576.v b/test-suite/bugs/closed/bug_1576.v new file mode 100644 index 0000000000..0889568d82 --- /dev/null +++ b/test-suite/bugs/closed/bug_1576.v @@ -0,0 +1,37 @@ +Module Type TA. +Parameter t : Set. +End TA. + +Module Type TB. +Declare Module A: TA. +End TB. + +Module Type TC. +Declare Module B : TB. +End TC. + +Module Type TD. + +Declare Module B: TB . +Declare Module C: TC + with Module B := B . +End TD. + +Module Type TE. +Declare Module D : TD. +End TE. + +Module Type TF. +Declare Module E: TE. +End TF. + +Module G (D: TD). +Module B' := D.C.B. +End G. + +Module H (F: TF). +Module I := G(F.E.D). +End H. + +Declare Module F: TF. +Module K := H(F). diff --git a/test-suite/bugs/closed/bug_1582.v b/test-suite/bugs/closed/bug_1582.v new file mode 100644 index 0000000000..88af924934 --- /dev/null +++ b/test-suite/bugs/closed/bug_1582.v @@ -0,0 +1,14 @@ +Require Import Peano_dec. + +Definition fact_F : + forall (n:nat), + (forall m, m nat) -> + nat. +refine + (fun n fact_rec => + if eq_nat_dec n 0 then + 1 + else + let fn := fact_rec (n-1) _ in + n * fn). +Admitted. diff --git a/test-suite/bugs/closed/bug_1584.v b/test-suite/bugs/closed/bug_1584.v new file mode 100644 index 0000000000..926af7dd1c --- /dev/null +++ b/test-suite/bugs/closed/bug_1584.v @@ -0,0 +1,5 @@ +Require Export Reals. + +Parameter toto : nat -> nat -> nat. + +Notation " e # f " := (toto e f) (at level 30, f at level 0). diff --git a/test-suite/bugs/closed/bug_1604.v b/test-suite/bugs/closed/bug_1604.v new file mode 100644 index 0000000000..22c3df824b --- /dev/null +++ b/test-suite/bugs/closed/bug_1604.v @@ -0,0 +1,7 @@ +Require Import Setoid. + +Parameter F : nat -> nat. +Axiom F_id : forall n : nat, n = F n. +Goal forall n : nat, F n = n. +intro n. setoid_rewrite F_id at 3. reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_1614.v b/test-suite/bugs/closed/bug_1614.v new file mode 100644 index 0000000000..6bc165d406 --- /dev/null +++ b/test-suite/bugs/closed/bug_1614.v @@ -0,0 +1,21 @@ +Require Import Ring. +Require Import ArithRing. + +Fixpoint eq_nat_bool (x y : nat) {struct x} : bool := +match x, y with +| 0, 0 => true +| S x', S y' => eq_nat_bool x' y' +| _, _ => false +end. + +Theorem eq_nat_bool_implies_eq : forall x y, eq_nat_bool x y = true -> x = y. +Proof. +induction x; destruct y; simpl; intro H; try (reflexivity || inversion H). +apply IHx in H; rewrite H; reflexivity. +Qed. + +Add Ring MyNatSRing : natSRth (decidable eq_nat_bool_implies_eq). + +Goal 0 = 0. + ring. +Qed. diff --git a/test-suite/bugs/closed/bug_1618.v b/test-suite/bugs/closed/bug_1618.v new file mode 100644 index 0000000000..a7be12e26f --- /dev/null +++ b/test-suite/bugs/closed/bug_1618.v @@ -0,0 +1,22 @@ +Inductive A: Set := +| A1: nat -> A. + +Definition A_size (a: A) : nat := + match a with + | A1 n => 0 + end. + +Require Import Recdef. + +Function n3 (P: A -> Prop) (f: forall n, P (A1 n)) (a: A) {struct a} : P a := + match a return (P a) with + | A1 n => f n + end. + + +Function n1 (P: A -> Prop) (f: forall n, P (A1 n)) (a: A) {measure A_size a} : +P +a := + match a return (P a) with + | A1 n => f n + end. diff --git a/test-suite/bugs/closed/bug_1634.v b/test-suite/bugs/closed/bug_1634.v new file mode 100644 index 0000000000..0150c25038 --- /dev/null +++ b/test-suite/bugs/closed/bug_1634.v @@ -0,0 +1,24 @@ +Require Export Relation_Definitions. +Require Export Setoid. + +Variable A : Type. +Variable S : A -> Type. +Variable Seq : forall {a:A}, relation (S a). + +Hypothesis Seq_refl : forall {a:A} (x : S a), Seq x x. +Hypothesis Seq_sym : forall {a:A} (x y : S a), Seq x y -> Seq y x. +Hypothesis Seq_trans : forall {a:A} (x y z : S a), Seq x y -> Seq y z -> +Seq x z. + +Add Parametric Relation a : (S a) Seq + reflexivity proved by Seq_refl + symmetry proved by Seq_sym + transitivity proved by Seq_trans + as S_Setoid. + +Goal forall (a : A) (x y : S a), Seq x y -> Seq x y. + intros a x y H. + setoid_replace x with y. + reflexivity. + trivial. +Qed. diff --git a/test-suite/bugs/closed/bug_1643.v b/test-suite/bugs/closed/bug_1643.v new file mode 100644 index 0000000000..879a65b183 --- /dev/null +++ b/test-suite/bugs/closed/bug_1643.v @@ -0,0 +1,20 @@ +(* Check some aspects of that the algorithm used to possibly reuse a + global name in the recursive calls (coinductive case) *) + +CoInductive Str : Set := Cons (h:nat) (t:Str). + +Definition decomp_func (s:Str) := + match s with + | Cons h t => Cons h t + end. + +Theorem decomp s: s = decomp_func s. +Proof. + case s; simpl; reflexivity. +Qed. + +Definition zeros := (cofix z : Str := Cons 0 z). +Lemma zeros_rw : zeros = Cons 0 zeros. + rewrite (decomp zeros). + simpl. +Admitted. diff --git a/test-suite/bugs/closed/bug_1680.v b/test-suite/bugs/closed/bug_1680.v new file mode 100644 index 0000000000..fa563f32d7 --- /dev/null +++ b/test-suite/bugs/closed/bug_1680.v @@ -0,0 +1,7 @@ +Ltac int1 := let h := fresh in intro h. + +Goal nat -> nat -> True. + let h' := fresh in (let h := fresh in intro h); intro h'. + Restart. let h' := fresh in int1; intro h'. + trivial. +Qed. diff --git a/test-suite/bugs/closed/bug_1683.v b/test-suite/bugs/closed/bug_1683.v new file mode 100644 index 0000000000..802057fa8c --- /dev/null +++ b/test-suite/bugs/closed/bug_1683.v @@ -0,0 +1,39 @@ +Require Import Setoid. + +Section SetoidBug. + +Variable ms : Type. +Variable ms_type : ms -> Type. +Variable ms_eq : forall (A:ms), relation (ms_type A). + +Variable CR : ms. + +Record Ring : Type := +{Ring_type : Type}. + +Variable foo : forall (A:Ring), nat -> Ring_type A. +Variable IR : Ring. +Variable IRasCR : Ring_type IR -> ms_type CR. + +Definition CRasCRing : Ring := Build_Ring (ms_type CR). + +Hypothesis ms_refl : forall A x, ms_eq A x x. +Hypothesis ms_sym : forall A x y, ms_eq A x y -> ms_eq A y x. +Hypothesis ms_trans : forall A x y z, ms_eq A x y -> ms_eq A y z -> ms_eq A x z. + +Add Parametric Relation A : (ms_type A) (ms_eq A) + reflexivity proved by (ms_refl A) + symmetry proved by (ms_sym A) + transitivity proved by (ms_trans A) + as ms_Setoid. + +Hypothesis foobar : forall n, ms_eq CR (IRasCR (foo IR n)) (foo CRasCRing n). + +Goal forall (b:ms_type CR), + ms_eq CR (IRasCR (foo IR O)) b -> + ms_eq CR (IRasCR (foo IR O)) b. +intros b H. +rewrite foobar. +rewrite foobar in H. +assumption. +Qed. diff --git a/test-suite/bugs/closed/bug_1696.v b/test-suite/bugs/closed/bug_1696.v new file mode 100644 index 0000000000..0826428a34 --- /dev/null +++ b/test-suite/bugs/closed/bug_1696.v @@ -0,0 +1,16 @@ +Require Import Setoid. + +Inductive mynat := z : mynat | s : mynat -> mynat. + +Parameter E : mynat -> mynat -> Prop. +Axiom E_equiv : equiv mynat E. + +Add Relation mynat E + reflexivity proved by (proj1 E_equiv) + symmetry proved by (proj2 (proj2 E_equiv)) + transitivity proved by (proj1 (proj2 E_equiv)) +as E_rel. + +Notation "x == y" := (E x y) (at level 70). + +Goal z == s z -> s z == z. intros H. setoid_rewrite H at 2. reflexivity. Qed. diff --git a/test-suite/bugs/closed/bug_1703.v b/test-suite/bugs/closed/bug_1703.v new file mode 100644 index 0000000000..114e3185b8 --- /dev/null +++ b/test-suite/bugs/closed/bug_1703.v @@ -0,0 +1,8 @@ +(* Check correct binding of intros until used in Ltac *) + +Ltac intros_until n := intros until n. + +Goal forall i j m n : nat, i = 0 /\ j = 0 /\ m = 0 /\ n = 0. +intro i. +Fail intros until i. +Abort. diff --git a/test-suite/bugs/closed/bug_1704.v b/test-suite/bugs/closed/bug_1704.v new file mode 100644 index 0000000000..7d8ba5b8da --- /dev/null +++ b/test-suite/bugs/closed/bug_1704.v @@ -0,0 +1,18 @@ +Require Import TestSuite.admit. + +Require Import Setoid. +Parameter E : nat -> nat -> Prop. +Axiom E_equiv : equiv nat E. +Add Relation nat E +reflexivity proved by (proj1 E_equiv) +symmetry proved by (proj2 (proj2 E_equiv)) +transitivity proved by (proj1 (proj2 E_equiv)) +as E_rel. +Notation "x == y" := (E x y) (at level 70, no associativity). +Axiom r : False -> 0 == 1. +Goal 0 == 0. +Proof. +rewrite r. +reflexivity. +admit. +Qed. diff --git a/test-suite/bugs/closed/bug_1711.v b/test-suite/bugs/closed/bug_1711.v new file mode 100644 index 0000000000..e16612e380 --- /dev/null +++ b/test-suite/bugs/closed/bug_1711.v @@ -0,0 +1,34 @@ +(* Test for evar map consistency - was failing at some point and was *) +(* assumed to be solved from revision 10151 (but using a bad fix) *) + +Require Import List. +Set Implicit Arguments. + +Inductive rose : Set := Rose : nat -> list rose -> rose. + +Section RoseRec. +Variables (P: rose -> Set)(L: list rose -> Set). +Hypothesis + (R: forall n rs, L rs -> P (Rose n rs)) + (Lnil: L nil) + (Lcons: forall r rs, P r -> L rs -> L (cons r rs)). + +Fixpoint rose_rec2 (t:rose) {struct t} : P t := + match t as x return P x with + | Rose n rs => + R n ((fix rs_ind (l' : list rose): L l' := + match l' as x return L x with + | nil => Lnil + | cons t tl => Lcons (rose_rec2 t) (rs_ind tl) + end) + rs) + end. +End RoseRec. + +Lemma rose_map : rose -> rose. +Proof. intro H; elim H using rose_rec2 with + (L:=fun _ => list rose); (* was assumed to fail here *) +(* (L:=fun (_:list rose) => list rose); *) + clear H; simpl; intros. + exact (Rose n rs). exact nil. exact (H::H0). +Defined. diff --git a/test-suite/bugs/closed/bug_1718.v b/test-suite/bugs/closed/bug_1718.v new file mode 100644 index 0000000000..715fa94199 --- /dev/null +++ b/test-suite/bugs/closed/bug_1718.v @@ -0,0 +1,9 @@ +(* lazy delta unfolding used to miss delta on rels and vars (fixed in 10172) *) + +Check + let g := fun _ => 0 in + fix f (n : nat) := + match n with + | 0 => g f + | S n' => 0 + end. diff --git a/test-suite/bugs/closed/bug_1738.v b/test-suite/bugs/closed/bug_1738.v new file mode 100644 index 0000000000..ef52c876c1 --- /dev/null +++ b/test-suite/bugs/closed/bug_1738.v @@ -0,0 +1,30 @@ +Require Import FSets. + +Module SomeSetoids (Import M:FSetInterface.S). + +Lemma Equal_refl : forall s, s[=]s. +Proof. red; split; auto. Qed. + +Add Relation t Equal + reflexivity proved by Equal_refl + symmetry proved by eq_sym + transitivity proved by eq_trans + as EqualSetoid. + +Add Morphism Empty with signature Equal ==> iff as Empty_m. +Proof. +unfold Equal, Empty; firstorder. +Qed. + +End SomeSetoids. + +Module Test (Import M:FSetInterface.S). + Module A:=SomeSetoids M. + Module B:=SomeSetoids M. (* lots of warning *) + + Lemma Test : forall s s', s[=]s' -> Empty s -> Empty s'. + intros. + rewrite H in H0. + assumption. +Qed. +End Test. diff --git a/test-suite/bugs/closed/bug_1740.v b/test-suite/bugs/closed/bug_1740.v new file mode 100644 index 0000000000..3b882dc4ca --- /dev/null +++ b/test-suite/bugs/closed/bug_1740.v @@ -0,0 +1,22 @@ +(* Check that expansion of alias in pattern-matching compilation is no + longer dependent of whether the pattern-matching problem occurs in a + typed context or at toplevel (solved from revision 10883) *) + +Definition f := + fun n m : nat => + match n, m with + | O, _ => O + | n, O => n + | _, _ => O + end. + +Goal f = + fun n m : nat => + match n, m with + | O, _ => O + | n, O => n + | _, _ => O + end. + unfold f. + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_1754.v b/test-suite/bugs/closed/bug_1754.v new file mode 100644 index 0000000000..06b8dce851 --- /dev/null +++ b/test-suite/bugs/closed/bug_1754.v @@ -0,0 +1,24 @@ +Axiom hp : Set. +Axiom cont : nat -> hp -> Prop. +Axiom sconj : (hp -> Prop) -> (hp -> Prop) -> hp -> Prop. +Axiom sconjImpl : forall h A B, + (sconj A B) h -> forall (A' B': hp -> Prop), + (forall h', A h' -> A' h') -> + (forall h', B h' -> B' h') -> + (sconj A' B') h. + +Definition cont' (h:hp) := exists y, cont y h. + +Lemma foo : forall h x y A, + (sconj (cont x) (sconj (cont y) A)) h -> + (sconj cont' (sconj cont' A)) h. +Proof. + intros h x y A H. + eapply sconjImpl. + 2:intros h' Hp'; econstructor; apply Hp'. + 2:intros h' Hp'; eapply sconjImpl. + 3:intros h'' Hp''; econstructor; apply Hp''. + 3:intros h'' Hp''; apply Hp''. + 2:apply Hp'. + clear H. +Admitted. diff --git a/test-suite/bugs/closed/bug_1773.v b/test-suite/bugs/closed/bug_1773.v new file mode 100644 index 0000000000..211af89b70 --- /dev/null +++ b/test-suite/bugs/closed/bug_1773.v @@ -0,0 +1,9 @@ +(* An occur-check test was done too early *) + +Goal forall B C : nat -> nat -> Prop, forall k, + (exists A, (forall k', C A k' -> B A k') -> B A k). +Proof. + intros B C k. + econstructor. + intros X. + apply X. (* used to fail here *) diff --git a/test-suite/bugs/closed/bug_1774.v b/test-suite/bugs/closed/bug_1774.v new file mode 100644 index 0000000000..4c24b481bd --- /dev/null +++ b/test-suite/bugs/closed/bug_1774.v @@ -0,0 +1,18 @@ +Axiom pl : (nat -> Prop) -> (nat -> Prop) -> (nat -> Prop). +Axiom plImp : forall k P Q, + pl P Q k -> forall (P':nat -> Prop), + (forall k', P k' -> P' k') -> forall (Q':nat -> Prop), + (forall k', Q k' -> Q' k') -> + pl P' Q' k. + +Definition nexists (P:nat -> nat -> Prop) : nat -> Prop := + fun k' => exists k, P k k'. + +Goal forall k (A:nat -> nat -> Prop) (B:nat -> Prop), + pl (nexists A) B k. +intros. +eapply plImp. +2:intros m' M'; econstructor; apply M'. +2:intros m' M'; apply M'. +simpl. +Admitted. diff --git a/test-suite/bugs/closed/bug_1775.v b/test-suite/bugs/closed/bug_1775.v new file mode 100644 index 0000000000..932949a371 --- /dev/null +++ b/test-suite/bugs/closed/bug_1775.v @@ -0,0 +1,39 @@ +Axiom pair : nat -> nat -> nat -> Prop. +Axiom pl : (nat -> Prop) -> (nat -> Prop) -> (nat -> Prop). +Axiom plImp : forall k P Q, + pl P Q k -> forall (P':nat -> Prop), + (forall k', P k' -> P' k') -> forall (Q':nat -> Prop), + (forall k', Q k' -> Q' k') -> + pl P' Q' k. + +Definition nexists (P:nat -> nat -> Prop) : nat -> Prop := + fun k' => exists k, P k k'. + +Goal forall s k k' m, + (pl k' (nexists (fun w => (nexists (fun b => pl (pair w w) + (pl (pair s b) + (nexists (fun w0 => (nexists (fun a => pl (pair b w0) + (nexists (fun w1 => (nexists (fun c => pl + (pair a w1) (pl (pair a c) k))))))))))))))) m. +intros. +eapply plImp; [ | eauto | intros ]. +2:econstructor. +2:econstructor. +2:eapply plImp; [ | eauto | intros ]. +3:eapply plImp; [ | eauto | intros ]. +4:econstructor. +4:econstructor. +4:eapply plImp; [ | eauto | intros ]. +5:econstructor. +5:econstructor. +5:eauto. +4:eauto. +3:eauto. +2:eauto. + +assert (X := 1). +clear X. (* very slow! *) + +simpl. (* exception Not_found *) + +Admitted. diff --git a/test-suite/bugs/closed/bug_1776.v b/test-suite/bugs/closed/bug_1776.v new file mode 100644 index 0000000000..58491f9de1 --- /dev/null +++ b/test-suite/bugs/closed/bug_1776.v @@ -0,0 +1,22 @@ +Axiom pair : nat -> nat -> nat -> Prop. +Axiom pl : (nat -> Prop) -> (nat -> Prop) -> (nat -> Prop). +Axiom plImpR : forall k P Q, + pl P Q k -> forall (Q':nat -> Prop), + (forall k', Q k' -> Q' k') -> + pl P Q' k. + +Definition nexists (P:nat -> nat -> Prop) : nat -> Prop := + fun k' => exists k, P k k'. + +Goal forall a A m, + True -> + (pl A (nexists (fun x => (nexists + (fun y => pl (pair a (S x)) (pair a (S y))))))) m. +Proof. + intros. + eapply plImpR; [ | intros; econstructor; econstructor; eauto]. + clear H; + match goal with + | |- (pl _ (pl (pair _ ?x) _)) _ => replace x with 0 + end. +Admitted. diff --git a/test-suite/bugs/closed/bug_1779.v b/test-suite/bugs/closed/bug_1779.v new file mode 100644 index 0000000000..95bb66b962 --- /dev/null +++ b/test-suite/bugs/closed/bug_1779.v @@ -0,0 +1,25 @@ +Require Import Div2. + +Lemma double_div2: forall n, div2 (double n) = n. +exact (fun n => let _subcase := + let _cofact := fun _ : 0 = 0 => refl_equal 0 in + _cofact (let _fact := refl_equal 0 in _fact) in + let _subcase0 := + fun (m : nat) (Hrec : div2 (double m) = m) => + let _fact := f_equal div2 (double_S m) in + let _eq := trans_eq _fact (refl_equal (S (div2 (double m)))) in + let _eq0 := + trans_eq _eq + (trans_eq + (f_equal (fun f : nat -> nat => f (div2 (double m))) + (refl_equal S)) (f_equal S Hrec)) in + _eq0 in + (fix _fix (__ : nat) : div2 (double __) = __ := + match __ as n return (div2 (double n) = n) with + | 0 => _subcase + | S __0 => + (fun _hrec : div2 (double __0) = __0 => _subcase0 __0 _hrec) + (_fix __0) + end) n). +Guarded. +Defined. diff --git a/test-suite/bugs/closed/bug_1780.v b/test-suite/bugs/closed/bug_1780.v new file mode 100644 index 0000000000..ade4462a79 --- /dev/null +++ b/test-suite/bugs/closed/bug_1780.v @@ -0,0 +1,12 @@ + +Definition bug := Eval vm_compute in eq_rect. +(* bug: +Error: Illegal application (Type Error): +The term "eq" of type "forall A : Type, A -> A -> Prop" +cannot be applied to the terms + "x" : "A" + "P" : "A -> Type" + "x0" : "A" +The 1st term has type "A" which should be coercible to +"Type". +*) diff --git a/test-suite/bugs/closed/bug_1784.v b/test-suite/bugs/closed/bug_1784.v new file mode 100644 index 0000000000..93d7f6ab75 --- /dev/null +++ b/test-suite/bugs/closed/bug_1784.v @@ -0,0 +1,99 @@ +Require Import List. +Require Import ZArith. +Require String. Open Scope string_scope. +Ltac Case s := let c := fresh "case" in set (c := s). + +Set Implicit Arguments. +Unset Strict Implicit. + +Inductive sv : Set := +| I : Z -> sv +| S : list sv -> sv. + +Section sv_induction. + +Variables + (VP: sv -> Prop) + (LP: list sv -> Prop) + + (VPint: forall n, VP (I n)) + (VPset: forall vs, LP vs -> VP (S vs)) + (lpcons: forall v vs, VP v -> LP vs -> LP (v::vs)) + (lpnil: LP nil). + +Fixpoint setl_value_indp (x:sv) {struct x}: VP x := + match x as x return VP x with + | I n => VPint n + | S vs => + VPset + ((fix values_indp (vs:list sv) {struct vs}: (LP vs) := + match vs as vs return LP vs with + | nil => lpnil + | v::vs => lpcons (setl_value_indp v) (values_indp vs) + end) vs) + end. +End sv_induction. + +Inductive slt : sv -> sv -> Prop := +| IC : forall z, slt (I z) (I z) +| IS : forall vs vs', slist_in vs vs' -> slt (S vs) (S vs') + +with sin : sv -> list sv -> Prop := +| Ihd : forall s s' sv', slt s s' -> sin s (s'::sv') +| Itl : forall s s' sv', sin s sv' -> sin s (s'::sv') + +with slist_in : list sv -> list sv -> Prop := +| Inil : forall sv', + slist_in nil sv' +| Icons : forall s sv sv', + sin s sv' -> + slist_in sv sv' -> + slist_in (s::sv) sv'. + +Hint Constructors sin slt slist_in. + +Require Import Program. + +Program Fixpoint lt_dec (x y:sv) { struct x } : {slt x y}+{~slt x y} := + match x with + | I x => + match y with + | I y => if (Z.eq_dec x y) then in_left else in_right + | S ys => in_right + end + | S xs => + match y with + | I y => in_right + | S ys => + let fix list_in (xs ys:list sv) {struct xs} : + {slist_in xs ys} + {~slist_in xs ys} := + match xs with + | nil => in_left + | x::xs => + let fix elem_in (ys:list sv) : {sin x ys}+{~sin x ys} := + match ys with + | nil => in_right + | y::ys => if lt_dec x y then in_left else if elem_in + ys then in_left else in_right + end + in + if elem_in ys then + if list_in xs ys then in_left else in_right + else in_right + end + in if list_in xs ys then in_left else in_right + end + end. + +Next Obligation. intro H0. apply H; inversion H0; subst; trivial. Defined. +Next Obligation. intro H; inversion H. Defined. +Next Obligation. intro H; inversion H. Defined. +Next Obligation. intro H; inversion H; subst. Defined. +Next Obligation. + intro H1; contradict H. inversion H1; subst. assumption. + contradict H0; assumption. Defined. +Next Obligation. intro H1; contradict H0. inversion H1; subst. assumption. Defined. +Next Obligation. + intro H1; contradict H. inversion H1; subst. assumption. Defined. +Next Obligation. + intro H0; contradict H. inversion H0; subst; auto. Defined. diff --git a/test-suite/bugs/closed/bug_1787.v b/test-suite/bugs/closed/bug_1787.v new file mode 100644 index 0000000000..e3cf9f4b40 --- /dev/null +++ b/test-suite/bugs/closed/bug_1787.v @@ -0,0 +1,9 @@ +Parameter P : nat -> nat -> Prop. +Parameter Q : nat -> nat -> Prop. +Axiom A : forall x x' x'', P x x' -> Q x'' x' -> P x x''. + +Goal (P 1 3) -> (Q 1 3) -> (P 1 1). +intros H H'. +refine ((fun H1 : P 1 _ => let H2 := (_:Q 1 _) in A _ _ _ H1 H2) _). +clear. +Admitted. diff --git a/test-suite/bugs/closed/bug_1791.v b/test-suite/bugs/closed/bug_1791.v new file mode 100644 index 0000000000..be0e8ae8ba --- /dev/null +++ b/test-suite/bugs/closed/bug_1791.v @@ -0,0 +1,38 @@ +(* simpl performs eta expansion *) + +Set Implicit Arguments. +Require Import List. + +Definition k0 := Set. +Definition k1 := k0 -> k0. + +(** iterating X n times *) +Fixpoint Pow (X:k1)(k:nat){struct k}:k1:= + match k with 0 => fun X => X + | S k' => fun A => X (Pow X k' A) + end. + +Parameter Bush: k1. +Parameter BushToList: forall (A:k0), Bush A -> list A. + +Definition BushnToList (n:nat)(A:k0)(t:Pow Bush n A): list A. +Proof. + intros. + induction n. + exact (t::nil). + simpl in t. + exact (flat_map IHn (BushToList t)). +Defined. + +Parameter bnil : forall (A:k0), Bush A. +Axiom BushToList_bnil: forall (A:k0), BushToList (bnil A) = nil(A:=A). + +Lemma BushnToList_bnil (n:nat)(A:k0): + BushnToList (S n) A (bnil (Pow Bush n A)) = nil. +Proof. + intros. + simpl. + rewrite BushToList_bnil. + simpl. + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_1834.v b/test-suite/bugs/closed/bug_1834.v new file mode 100644 index 0000000000..884ac01cd2 --- /dev/null +++ b/test-suite/bugs/closed/bug_1834.v @@ -0,0 +1,174 @@ +(* This tests rather deep nesting of abstracted terms *) + +(* This used to fail before Nov 2011 because of a de Bruijn indice bug + in extract_predicate. + + Note: use of eq_ok allows shorten notations but was not in the + original example +*) + +Scheme eq_rec_dep := Induction for eq Sort Type. + +Section Teq. + +Variable P0: Type. +Variable P1: forall (y0:P0), Type. +Variable P2: forall y0 (y1:P1 y0), Type. +Variable P3: forall y0 y1 (y2:P2 y0 y1), Type. +Variable P4: forall y0 y1 y2 (y3:P3 y0 y1 y2), Type. +Variable P5: forall y0 y1 y2 y3 (y4:P4 y0 y1 y2 y3), Type. + +Variable x0:P0. + +Inductive eq0 : P0 -> Prop := + refl0: eq0 x0. + +Definition eq_0 y0 := x0 = y0. + +Variable x1:P1 x0. + +Inductive eq1 : forall y0, P1 y0 -> Prop := + refl1: eq1 x0 x1. + +Definition S0_0 y0 (e0:eq_0 y0) := + eq_rec_dep P0 x0 (fun y0 e0 => P1 y0) x1 y0 e0. + +Definition eq_ok0 y0 y1 (E: eq_0 y0) := S0_0 y0 E = y1. + +Definition eq_1 y0 y1 := + {E0:eq_0 y0 | eq_ok0 y0 y1 E0}. + +Variable x2:P2 x0 x1. + +Inductive eq2 : +forall y0 y1, P2 y0 y1 -> Prop := +refl2: eq2 x0 x1 x2. + +Definition S1_0 y0 (e0:eq_0 y0) := +eq_rec_dep P0 x0 (fun y0 e0 => P2 y0 (S0_0 y0 e0)) x2 y0 e0. + +Definition S1_1 y0 y1 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) := + eq_rec_dep (P1 y0) (S0_0 y0 e0) (fun y1 e1 => P2 y0 y1) + (S1_0 y0 e0) + y1 e1. + +Definition eq_ok1 y0 y1 y2 (E: eq_1 y0 y1) := + match E with exist _ e0 e1 => S1_1 y0 y1 e0 e1 = y2 end. + +Definition eq_2 y0 y1 y2 := + {E1:eq_1 y0 y1 | eq_ok1 y0 y1 y2 E1}. + +Variable x3:P3 x0 x1 x2. + +Inductive eq3 : +forall y0 y1 y2, P3 y0 y1 y2 -> Prop := +refl3: eq3 x0 x1 x2 x3. + +Definition S2_0 y0 (e0:eq_0 y0) := +eq_rec_dep P0 x0 (fun y0 e0 => P3 y0 (S0_0 y0 e0) (S1_0 y0 e0)) x3 y0 e0. + +Definition S2_1 y0 y1 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) := + eq_rec_dep (P1 y0) (S0_0 y0 e0) + (fun y1 e1 => P3 y0 y1 (S1_1 y0 y1 e0 e1)) + (S2_0 y0 e0) + y1 e1. + +Definition S2_2 y0 y1 y2 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) + (e2:S1_1 y0 y1 e0 e1 = y2) := + eq_rec_dep (P2 y0 y1) (S1_1 y0 y1 e0 e1) + (fun y2 e2 => P3 y0 y1 y2) + (S2_1 y0 y1 e0 e1) + y2 e2. + +Definition eq_ok2 y0 y1 y2 y3 (E: eq_2 y0 y1 y2) : Prop := + match E with exist _ (exist _ e0 e1) e2 => + S2_2 y0 y1 y2 e0 e1 e2 = y3 end. + +Definition eq_3 y0 y1 y2 y3 := + {E2: eq_2 y0 y1 y2 | eq_ok2 y0 y1 y2 y3 E2}. + +Variable x4:P4 x0 x1 x2 x3. + +Inductive eq4 : +forall y0 y1 y2 y3, P4 y0 y1 y2 y3 -> Prop := +refl4: eq4 x0 x1 x2 x3 x4. + +Definition S3_0 y0 (e0:eq_0 y0) := +eq_rec_dep P0 x0 (fun y0 e0 => P4 y0 (S0_0 y0 e0) (S1_0 y0 e0) (S2_0 y0 e0)) + x4 y0 e0. + +Definition S3_1 y0 y1 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) := + eq_rec_dep (P1 y0) (S0_0 y0 e0) + (fun y1 e1 => P4 y0 y1 (S1_1 y0 y1 e0 e1) (S2_1 y0 y1 e0 e1)) + (S3_0 y0 e0) + y1 e1. + +Definition S3_2 y0 y1 y2 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) + (e2:S1_1 y0 y1 e0 e1 = y2) := + eq_rec_dep (P2 y0 y1) (S1_1 y0 y1 e0 e1) + (fun y2 e2 => P4 y0 y1 y2 (S2_2 y0 y1 y2 e0 e1 e2)) + (S3_1 y0 y1 e0 e1) + y2 e2. + +Definition S3_3 y0 y1 y2 y3 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) + (e2:S1_1 y0 y1 e0 e1 = y2) (e3:S2_2 y0 y1 y2 e0 e1 e2 = y3):= + eq_rec_dep (P3 y0 y1 y2) (S2_2 y0 y1 y2 e0 e1 e2) + (fun y3 e3 => P4 y0 y1 y2 y3) + (S3_2 y0 y1 y2 e0 e1 e2) + y3 e3. + +Definition eq_ok3 y0 y1 y2 y3 y4 (E: eq_3 y0 y1 y2 y3) : Prop := + match E with exist _ (exist _ (exist _ e0 e1) e2) e3 => + S3_3 y0 y1 y2 y3 e0 e1 e2 e3 = y4 end. + +Definition eq_4 y0 y1 y2 y3 y4 := + {E3: eq_3 y0 y1 y2 y3 | eq_ok3 y0 y1 y2 y3 y4 E3}. + +Variable x5:P5 x0 x1 x2 x3 x4. + +Inductive eq5 : +forall y0 y1 y2 y3 y4, P5 y0 y1 y2 y3 y4 -> Prop := +refl5: eq5 x0 x1 x2 x3 x4 x5. + +Definition S4_0 y0 (e0:eq_0 y0) := +eq_rec_dep P0 x0 +(fun y0 e0 => P5 y0 (S0_0 y0 e0) (S1_0 y0 e0) (S2_0 y0 e0) (S3_0 y0 e0)) + x5 y0 e0. + +Definition S4_1 y0 y1 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) := + eq_rec_dep (P1 y0) (S0_0 y0 e0) + (fun y1 e1 => P5 y0 y1 (S1_1 y0 y1 e0 e1) (S2_1 y0 y1 e0 e1) (S3_1 y0 y1 e0 +e1)) + (S4_0 y0 e0) + y1 e1. + +Definition S4_2 y0 y1 y2 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) + (e2:S1_1 y0 y1 e0 e1 = y2) := + eq_rec_dep (P2 y0 y1) (S1_1 y0 y1 e0 e1) + (fun y2 e2 => P5 y0 y1 y2 (S2_2 y0 y1 y2 e0 e1 e2) (S3_2 y0 y1 y2 e0 e1 e2)) + (S4_1 y0 y1 e0 e1) + y2 e2. + +Definition S4_3 y0 y1 y2 y3 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) + (e2:S1_1 y0 y1 e0 e1 = y2) (e3:S2_2 y0 y1 y2 e0 e1 e2 = y3):= + eq_rec_dep (P3 y0 y1 y2) (S2_2 y0 y1 y2 e0 e1 e2) + (fun y3 e3 => P5 y0 y1 y2 y3 (S3_3 y0 y1 y2 y3 e0 e1 e2 e3)) + (S4_2 y0 y1 y2 e0 e1 e2) + y3 e3. + +Definition S4_4 y0 y1 y2 y3 y4 (e0:eq_0 y0) (e1:S0_0 y0 e0 = y1) + (e2:S1_1 y0 y1 e0 e1 = y2) (e3:S2_2 y0 y1 y2 e0 e1 e2 = y3) + (e4:S3_3 y0 y1 y2 y3 e0 e1 e2 e3 = y4) := + eq_rec_dep (P4 y0 y1 y2 y3) (S3_3 y0 y1 y2 y3 e0 e1 e2 e3) + (fun y4 e4 => P5 y0 y1 y2 y3 y4) + (S4_3 y0 y1 y2 y3 e0 e1 e2 e3) + y4 e4. + +Definition eq_ok4 y0 y1 y2 y3 y4 y5 (E: eq_4 y0 y1 y2 y3 y4) : Prop := + match E with exist _ (exist _ (exist _ (exist _ e0 e1) e2) e3) e4 => + S4_4 y0 y1 y2 y3 y4 e0 e1 e2 e3 e4 = y5 end. + +Definition eq_5 y0 y1 y2 y3 y4 y5 := + {E4: eq_4 y0 y1 y2 y3 y4 | eq_ok4 y0 y1 y2 y3 y4 y5 E4 }. + +End Teq. diff --git a/test-suite/bugs/closed/bug_1844.v b/test-suite/bugs/closed/bug_1844.v new file mode 100644 index 0000000000..c41e45900a --- /dev/null +++ b/test-suite/bugs/closed/bug_1844.v @@ -0,0 +1,217 @@ +Require Import ZArith. + +Definition zeq := Z.eq_dec. + +Definition update (A: Set) (x: Z) (v: A) (s: Z -> A) : Z -> A := + fun y => if zeq x y then v else s y. + +Arguments update [A]. + +Definition ident := Z. +Parameter operator: Set. +Parameter value: Set. +Parameter is_true: value -> Prop. +Definition label := Z. + +Inductive expr : Set := + | Evar: ident -> expr + | Econst: value -> expr + | Eop: operator -> expr -> expr -> expr. + +Inductive stmt : Set := + | Sskip: stmt + | Sassign: ident -> expr -> stmt + | Scall: ident -> ident -> expr -> stmt (* x := f(e) *) + | Sreturn: expr -> stmt + | Sseq: stmt -> stmt -> stmt + | Sifthenelse: expr -> stmt -> stmt -> stmt + | Sloop: stmt -> stmt + | Sblock: stmt -> stmt + | Sexit: nat -> stmt + | Slabel: label -> stmt -> stmt + | Sgoto: label -> stmt. + +Record function : Set := mkfunction { + fn_param: ident; + fn_body: stmt +}. + +Parameter program: ident -> option function. + +Parameter main_function: ident. + +Definition store := ident -> value. + +Parameter empty_store : store. + +Parameter eval_op: operator -> value -> value -> option value. + +Fixpoint eval_expr (st: store) (e: expr) {struct e} : option value := + match e with + | Evar v => Some (st v) + | Econst v => Some v + | Eop op e1 e2 => + match eval_expr st e1, eval_expr st e2 with + | Some v1, Some v2 => eval_op op v1 v2 + | _, _ => None + end + end. + +Inductive outcome: Set := + | Onormal: outcome + | Oexit: nat -> outcome + | Ogoto: label -> outcome + | Oreturn: value -> outcome. + +Definition outcome_block (out: outcome) : outcome := + match out with + | Onormal => Onormal + | Oexit O => Onormal + | Oexit (S m) => Oexit m + | Ogoto lbl => Ogoto lbl + | Oreturn v => Oreturn v + end. + +Fixpoint label_defined (lbl: label) (s: stmt) {struct s}: Prop := + match s with + | Sskip => False + | Sassign id e => False + | Scall id fn e => False + | Sreturn e => False + | Sseq s1 s2 => label_defined lbl s1 \/ label_defined lbl s2 + | Sifthenelse e s1 s2 => label_defined lbl s1 \/ label_defined lbl s2 + | Sloop s1 => label_defined lbl s1 + | Sblock s1 => label_defined lbl s1 + | Sexit n => False + | Slabel lbl1 s1 => lbl1 = lbl \/ label_defined lbl s1 + | Sgoto lbl => False + end. + +Inductive exec : stmt -> store -> outcome -> store -> Prop := + | exec_skip: forall st, + exec Sskip st Onormal st + | exec_assign: forall id e st v, + eval_expr st e = Some v -> + exec (Sassign id e) st Onormal (update id v st) + | exec_call: forall id fn e st v1 f v2 st', + eval_expr st e = Some v1 -> + program fn = Some f -> + exec_function f (update f.(fn_param) v1 empty_store) v2 st' -> + exec (Scall id fn e) st Onormal (update id v2 st) + | exec_return: forall e st v, + eval_expr st e = Some v -> + exec (Sreturn e) st (Oreturn v) st + | exec_seq_2: forall s1 s2 st st1 out' st', + exec s1 st Onormal st1 -> exec s2 st1 out' st' -> + exec (Sseq s1 s2) st out' st' + | exec_seq_1: forall s1 s2 st out st', + exec s1 st out st' -> out <> Onormal -> + exec (Sseq s1 s2) st out st' + | exec_ifthenelse_true: forall e s1 s2 st out st' v, + eval_expr st e = Some v -> is_true v -> exec s1 st out st' -> + exec (Sifthenelse e s1 s2) st out st' + | exec_ifthenelse_false: forall e s1 s2 st out st' v, + eval_expr st e = Some v -> ~is_true v -> exec s2 st out st' -> + exec (Sifthenelse e s1 s2) st out st' + | exec_loop_loop: forall s st st1 out' st', + exec s st Onormal st1 -> + exec (Sloop s) st1 out' st' -> + exec (Sloop s) st out' st' + | exec_loop_stop: forall s st st' out, + exec s st out st' -> out <> Onormal -> + exec (Sloop s) st out st' + | exec_block: forall s st out st', + exec s st out st' -> + exec (Sblock s) st (outcome_block out) st' + | exec_exit: forall n st, + exec (Sexit n) st (Oexit n) st + | exec_label: forall s lbl st st' out, + exec s st out st' -> + exec (Slabel lbl s) st out st' + | exec_goto: forall st lbl, + exec (Sgoto lbl) st (Ogoto lbl) st + +(** [execg lbl stmt st out st'] starts executing at label [lbl] within [s], + in initial store [st]. The result of the execution is the outcome + [out] with final store [st']. *) + +with execg: label -> stmt -> store -> outcome -> store -> Prop := + | execg_left_seq_2: forall lbl s1 s2 st st1 out' st', + execg lbl s1 st Onormal st1 -> exec s2 st1 out' st' -> + execg lbl (Sseq s1 s2) st out' st' + | execg_left_seq_1: forall lbl s1 s2 st out st', + execg lbl s1 st out st' -> out <> Onormal -> + execg lbl (Sseq s1 s2) st out st' + | execg_right_seq: forall lbl s1 s2 st out st', + ~(label_defined lbl s1) -> + execg lbl s2 st out st' -> + execg lbl (Sseq s1 s2) st out st' + | execg_ifthenelse_left: forall lbl e s1 s2 st out st', + execg lbl s1 st out st' -> + execg lbl (Sifthenelse e s1 s2) st out st' + | execg_ifthenelse_right: forall lbl e s1 s2 st out st', + ~(label_defined lbl s1) -> + execg lbl s2 st out st' -> + execg lbl (Sifthenelse e s1 s2) st out st' + | execg_loop_loop: forall lbl s st st1 out' st', + execg lbl s st Onormal st1 -> + exec (Sloop s) st1 out' st' -> + execg lbl (Sloop s) st out' st' + | execg_loop_stop: forall lbl s st st' out, + execg lbl s st out st' -> out <> Onormal -> + execg lbl (Sloop s) st out st' + | execg_block: forall lbl s st out st', + execg lbl s st out st' -> + execg lbl (Sblock s) st (outcome_block out) st' + | execg_label_found: forall lbl s st st' out, + exec s st out st' -> + execg lbl (Slabel lbl s) st out st' + | execg_label_notfound: forall lbl s lbl' st st' out, + lbl' <> lbl -> + execg lbl s st out st' -> + execg lbl (Slabel lbl' s) st out st' + +(** [exec_finish out st st'] takes the outcome [out] and the store [st] + at the end of the evaluation of the program. If [out] is a [goto], + execute again the program starting at the corresponding label. + Iterate this way until [out] is [Onormal]. *) + +with exec_finish: function -> outcome -> store -> value -> store -> Prop := + | exec_finish_normal: forall f st v, + exec_finish f (Oreturn v) st v st + | exec_finish_goto: forall f lbl st out v st1 st', + execg lbl f.(fn_body) st out st1 -> + exec_finish f out st1 v st' -> + exec_finish f (Ogoto lbl) st v st' + +(** Execution of a function *) + +with exec_function: function -> store -> value -> store -> Prop := + | exec_function_intro: forall f st out st1 v st', + exec f.(fn_body) st out st1 -> + exec_finish f out st1 v st' -> + exec_function f st v st'. + +Scheme exec_ind4:= Minimality for exec Sort Prop + with execg_ind4:= Minimality for execg Sort Prop + with exec_finish_ind4 := Minimality for exec_finish Sort Prop + with exec_function_ind4 := Minimality for exec_function Sort Prop. + +Scheme exec_dind4:= Induction for exec Sort Prop + with execg_dind4:= Minimality for execg Sort Prop + with exec_finish_dind4 := Induction for exec_finish Sort Prop + with exec_function_dind4 := Induction for exec_function Sort Prop. + +Combined Scheme exec_inductiond from exec_dind4, execg_dind4, exec_finish_dind4, + exec_function_dind4. + +Scheme exec_dind4' := Induction for exec Sort Prop + with execg_dind4' := Induction for execg Sort Prop + with exec_finish_dind4' := Induction for exec_finish Sort Prop + with exec_function_dind4' := Induction for exec_function Sort Prop. + +Combined Scheme exec_induction from exec_ind4, execg_ind4, exec_finish_ind4, + exec_function_ind4. + +Combined Scheme exec_inductiond' from exec_dind4', execg_dind4', exec_finish_dind4', + exec_function_dind4'. diff --git a/test-suite/bugs/closed/bug_1850.v b/test-suite/bugs/closed/bug_1850.v new file mode 100644 index 0000000000..b6d2edf8a7 --- /dev/null +++ b/test-suite/bugs/closed/bug_1850.v @@ -0,0 +1,3 @@ +Parameter P : Type -> Type -> Type. +Notation "e |= t --> v" := (P e t v) (at level 100, t at level 54). +Fail Check (nat |= nat --> nat). diff --git a/test-suite/bugs/closed/bug_1859.v b/test-suite/bugs/closed/bug_1859.v new file mode 100644 index 0000000000..43acfe4ba2 --- /dev/null +++ b/test-suite/bugs/closed/bug_1859.v @@ -0,0 +1,20 @@ +Require Import Ring. +Require Import ArithRing. + +Ltac ring_simplify_neq := + match goal with + | [ H: ?X <> ?Y |- _ ] => progress ring_simplify X Y in H + end. + +Lemma toto : forall x y, x*1 <> y*1 -> y*1 <> x*1 -> x<>y. +Proof. + intros. + ring_simplify_neq. + ring_simplify_neq. + (* make sure ring_simplify has simplified both hypotheses *) + match goal with + | [ H: context[_*1] |- _ ] => fail 1 + | _ => idtac + end. + auto. +Qed. diff --git a/test-suite/bugs/closed/bug_1865.v b/test-suite/bugs/closed/bug_1865.v new file mode 100644 index 0000000000..17c1998948 --- /dev/null +++ b/test-suite/bugs/closed/bug_1865.v @@ -0,0 +1,18 @@ +(* Check that tactics (here dependent inversion) do not generate + conversion problems T <= U with sup's of universes in U *) + +(* Submitted by David Nowak *) + +Inductive list (A:Set) : nat -> Set := +| nil : list A O +| cons : forall n, A -> list A n -> list A (S n). + +Definition f (n:nat) : Type := + match n with + | O => bool + | _ => unit + end. + +Goal forall A n, list A n -> f n. +intros A n. +dependent inversion n. diff --git a/test-suite/bugs/closed/bug_1891.v b/test-suite/bugs/closed/bug_1891.v new file mode 100644 index 0000000000..0e4f35efca --- /dev/null +++ b/test-suite/bugs/closed/bug_1891.v @@ -0,0 +1,12 @@ +(* Check evar-evar unification *) + Inductive T (A: Set): Set := mkT: unit -> T A. + + Definition f (A: Set) (l: T A): unit := tt. + + Arguments f [A]. + + Lemma L (x: T unit): (unit -> T unit) -> unit. + Proof. + refine (match x return _ with mkT _ n => fun g => f (g _) end). + trivial. + Qed. diff --git a/test-suite/bugs/closed/bug_1898.v b/test-suite/bugs/closed/bug_1898.v new file mode 100644 index 0000000000..70461286ce --- /dev/null +++ b/test-suite/bugs/closed/bug_1898.v @@ -0,0 +1,6 @@ +(* folding should not allow circular dependencies *) + +Lemma bug_fold_unfold : True. + set (h := 1). + Fail fold h in h. + Abort. diff --git a/test-suite/bugs/closed/bug_1900.v b/test-suite/bugs/closed/bug_1900.v new file mode 100644 index 0000000000..6eea5db083 --- /dev/null +++ b/test-suite/bugs/closed/bug_1900.v @@ -0,0 +1,8 @@ +Parameter A : Type . + +Definition eq_A := @eq A. + +Goal forall x, eq_A x x. +intros. +reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_1901.v b/test-suite/bugs/closed/bug_1901.v new file mode 100644 index 0000000000..98e017f9d6 --- /dev/null +++ b/test-suite/bugs/closed/bug_1901.v @@ -0,0 +1,11 @@ +Require Import Relations. + +Record Poset{A:Type}(Le : relation A) : Type := + Build_Poset + { + Le_refl : forall x : A, Le x x; + Le_trans : forall x y z : A, Le x y -> Le y z -> Le x z; + Le_antisym : forall x y : A, Le x y -> Le y x -> x = y }. + +Definition nat_Poset : Poset Peano.le. +Admitted. diff --git a/test-suite/bugs/closed/bug_1905.v b/test-suite/bugs/closed/bug_1905.v new file mode 100644 index 0000000000..3b8a3d2f68 --- /dev/null +++ b/test-suite/bugs/closed/bug_1905.v @@ -0,0 +1,13 @@ + +Require Import Setoid Program. + +Axiom t : Set. +Axiom In : nat -> t -> Prop. +Axiom InE : forall (x : nat) (s:t), impl (In x s) True. + +Goal forall a s, + In a s -> False. +Proof. + intros a s Ia. + rewrite InE in Ia. +Admitted. diff --git a/test-suite/bugs/closed/bug_1907.v b/test-suite/bugs/closed/bug_1907.v new file mode 100644 index 0000000000..55fc823190 --- /dev/null +++ b/test-suite/bugs/closed/bug_1907.v @@ -0,0 +1,7 @@ +(* An example of type inference *) + +Axiom A : Type. +Definition f (x y : A) := x. +Axiom g : forall x y : A, f x y = y -> Prop. +Axiom x : A. +Check (g x _ (refl_equal x)). diff --git a/test-suite/bugs/closed/bug_1912.v b/test-suite/bugs/closed/bug_1912.v new file mode 100644 index 0000000000..987a541778 --- /dev/null +++ b/test-suite/bugs/closed/bug_1912.v @@ -0,0 +1,6 @@ +Require Import ZArith. + +Goal forall x, Z.succ (Z.pred x) = x. +intros x. +omega. +Qed. diff --git a/test-suite/bugs/closed/bug_1915.v b/test-suite/bugs/closed/bug_1915.v new file mode 100644 index 0000000000..2b0aed8c7d --- /dev/null +++ b/test-suite/bugs/closed/bug_1915.v @@ -0,0 +1,6 @@ + +Require Import Setoid. + +Fail Goal forall x, impl True (x = 0) -> x = 0 -> False. +(*intros x H E. +rewrite H in E.*) diff --git a/test-suite/bugs/closed/bug_1918.v b/test-suite/bugs/closed/bug_1918.v new file mode 100644 index 0000000000..9d92fe12b8 --- /dev/null +++ b/test-suite/bugs/closed/bug_1918.v @@ -0,0 +1,376 @@ +(** Occur-check for Meta (up to delta) *) + +(** LNMItPredShort.v Version 2.0 July 2008 *) +(** does not need impredicative Set, runs under V8.2, tested with SVN 11296 *) + +(** Copyright Ralph Matthes, I.R.I.T., C.N.R.S. & University of Toulouse*) + + +Set Implicit Arguments. + +(** the universe of all monotypes *) +Definition k0 := Set. + +(** the type of all type transformations *) +Definition k1 := k0 -> k0. + +(** the type of all rank-2 type transformations *) +Definition k2 := k1 -> k1. + +(** polymorphic identity *) +Definition id : forall (A:Set), A -> A := fun A x => x. + +(** composition *) +Definition comp (A B C:Set)(g:B->C)(f:A->B) : A->C := fun x => g (f x). + +Infix "o" := comp (at level 90). + +Definition sub_k1 (X Y:k1) : Type := + forall A:Set, X A -> Y A. + +Infix "c_k1" := sub_k1 (at level 60). + +(** monotonicity *) +Definition mon (X:k1) : Type := forall (A B:Set), (A -> B) -> X A -> X B. + +(** extensionality *) +Definition ext (X:k1)(h: mon X): Prop := + forall (A B:Set)(f g:A -> B), + (forall a, f a = g a) -> forall r, h _ _ f r = h _ _ g r. + +(** first functor law *) +Definition fct1 (X:k1)(m: mon X) : Prop := + forall (A:Set)(x:X A), m _ _ (id(A:=A)) x = x. + +(** second functor law *) +Definition fct2 (X:k1)(m: mon X) : Prop := + forall (A B C:Set)(f:A -> B)(g:B -> C)(x:X A), + m _ _ (g o f) x = m _ _ g (m _ _ f x). + +(** pack up the good properties of the approximation into + the notion of an extensional functor *) +Record EFct (X:k1) : Type := mkEFct + { m : mon X; + e : ext m; + f1 : fct1 m; + f2 : fct2 m }. + +(** preservation of extensional functors *) +Definition pEFct (F:k2) : Type := + forall (X:k1), EFct X -> EFct (F X). + + +(** we show some closure properties of pEFct, depending on such properties + for EFct *) + +Definition moncomp (X Y:k1)(mX:mon X)(mY:mon Y): mon (fun A => X(Y A)). +Proof. + red. + intros A B f x. + exact (mX (Y A)(Y B) (mY A B f) x). +Defined. + +(** closure under composition *) +Lemma compEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X(Y A)). +Proof. + intros ef1 ef2. + apply (mkEFct(m:=moncomp (m ef1) (m ef2))); red; intros; unfold moncomp. +(* prove ext *) + apply (e ef1). + intro. + apply (e ef2); trivial. +(* prove fct1 *) + rewrite (e ef1 (m ef2 (id (A:=A))) (id(A:=Y A))). + apply (f1 ef1). + intro. + apply (f1 ef2). +(* prove fct2 *) + rewrite (e ef1 (m ef2 (g o f))((m ef2 g)o(m ef2 f))). + apply (f2 ef1). + intro. + unfold comp at 2. + apply (f2 ef2). +Defined. + +Corollary comppEFct (F G:k2): pEFct F -> pEFct G -> + pEFct (fun X A => F X (G X A)). +Proof. + red. + intros. + apply compEFct; auto. +Defined. + +(** closure under sums *) +Lemma sumEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X A + Y A)%type. +Proof. + intros ef1 ef2. + set (m12:=fun (A B:Set)(f:A->B) x => match x with + | inl y => inl _ (m ef1 f y) + | inr y => inr _ (m ef2 f y) + end). + apply (mkEFct(m:=m12)); red; intros. +(* prove ext *) + destruct r. + simpl. + apply (f_equal (fun x=>inl (A:=X B) (Y B) x)). + apply (e ef1); trivial. + simpl. + apply (f_equal (fun x=>inr (X B) (B:=Y B) x)). + apply (e ef2); trivial. +(* prove fct1 *) + destruct x. + simpl. + apply (f_equal (fun x=>inl (A:=X A) (Y A) x)). + apply (f1 ef1). + simpl. + apply (f_equal (fun x=>inr (X A) (B:=Y A) x)). + apply (f1 ef2). +(* prove fct2 *) + destruct x. + simpl. + rewrite (f2 ef1); reflexivity. + simpl. + rewrite (f2 ef2); reflexivity. +Defined. + +Corollary sumpEFct (F G:k2): pEFct F -> pEFct G -> + pEFct (fun X A => F X A + G X A)%type. +Proof. + red. + intros. + apply sumEFct; auto. +Defined. + +(** closure under products *) +Lemma prodEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X A * Y A)%type. +Proof. + intros ef1 ef2. + set (m12:=fun (A B:Set)(f:A->B) x => match x with + (x1,x2) => (m ef1 f x1, m ef2 f x2) end). + apply (mkEFct(m:=m12)); red; intros. +(* prove ext *) + destruct r as [x1 x2]. + simpl. + apply injective_projections; simpl. + apply (e ef1); trivial. + apply (e ef2); trivial. +(* prove fct1 *) + destruct x as [x1 x2]. + simpl. + apply injective_projections; simpl. + apply (f1 ef1). + apply (f1 ef2). +(* prove fct2 *) + destruct x as [x1 x2]. + simpl. + apply injective_projections; simpl. + apply (f2 ef1). + apply (f2 ef2). +Defined. + +Corollary prodpEFct (F G:k2): pEFct F -> pEFct G -> + pEFct (fun X A => F X A * G X A)%type. +Proof. + red. + intros. + apply prodEFct; auto. +Defined. + +(** the identity in k2 preserves extensional functors *) +Lemma idpEFct: pEFct (fun X => X). +Proof. + red. + intros. + assumption. +Defined. + +(** a variant for the eta-expanded identity *) +Lemma idpEFct_eta: pEFct (fun X A => X A). +Proof. + red. + intros X ef. + destruct ef as [m0 e0 f01 f02]. + change (mon X) with (mon (fun A => X A)) in m0. + apply (mkEFct (m:=m0) e0 f01 f02). +Defined. + +(** the identity in k1 "is" an extensional functor *) +Lemma idEFct: EFct (fun A => A). +Proof. + set (mId:=fun A B (f:A->B)(x:A) => f x). + apply (mkEFct(m:=mId)). + red. + intros. + unfold mId. + apply H. + red. + reflexivity. + red. + reflexivity. +Defined. + +(** constants in k2 *) +Lemma constpEFct (X:k1): EFct X -> pEFct (fun _ => X). +Proof. + red. + intros. + assumption. +Defined. + +(** constants in k1 *) +Lemma constEFct (C:Set): EFct (fun _ => C). +Proof. + set (mC:=fun A B (f:A->B)(x:C) => x). + apply (mkEFct(m:=mC)); red; intros; unfold mC; reflexivity. +Defined. + + +(** the option type *) +Lemma optionEFct: EFct (fun (A:Set) => option A). + apply (mkEFct (X:=fun (A:Set) => option A)(m:=option_map)); red; intros. + destruct r. + simpl. + rewrite H. + reflexivity. + reflexivity. + destruct x; reflexivity. + destruct x; reflexivity. +Defined. + + +(** natural transformations from (X,mX) to (Y,mY) *) +Definition NAT(X Y:k1)(j:X c_k1 Y)(mX:mon X)(mY:mon Y) : Prop := + forall (A B:Set)(f:A->B)(t:X A), j B (mX A B f t) = mY _ _ f (j A t). + + +Module Type LNMIt_Type. + +Parameter F:k2. +Parameter FpEFct: pEFct F. +Parameter mu20: k1. +Definition mu2: k1:= fun A => mu20 A. +Parameter mapmu2: mon mu2. +Definition MItType: Type := + forall G : k1, (forall X : k1, X c_k1 G -> F X c_k1 G) -> mu2 c_k1 G. +Parameter MIt0 : MItType. +Definition MIt : MItType:= fun G s A t => MIt0 s t. +Definition InType : Type := + forall (X:k1)(ef:EFct X)(j: X c_k1 mu2), + NAT j (m ef) mapmu2 -> F X c_k1 mu2. +Parameter In : InType. +Axiom mapmu2Red : forall (A:Set)(X:k1)(ef:EFct X)(j: X c_k1 mu2) + (n: NAT j (m ef) mapmu2)(t: F X A)(B:Set)(f:A->B), + mapmu2 f (In ef n t) = In ef n (m (FpEFct ef) f t). +Axiom MItRed : forall (G : k1) + (s : forall X : k1, X c_k1 G -> F X c_k1 G)(X : k1)(ef:EFct X)(j: X c_k1 mu2) + (n: NAT j (m ef) mapmu2)(A:Set)(t:F X A), + MIt s (In ef n t) = s X (fun A => (MIt s (A:=A)) o (j A)) A t. +Definition mu2IndType : Prop := + forall (P : (forall A : Set, mu2 A -> Prop)), + (forall (X : k1)(ef:EFct X)(j : X c_k1 mu2)(n: NAT j (m ef) mapmu2), + (forall (A : Set) (x : X A), P A (j A x)) -> + forall (A:Set)(t : F X A), P A (In ef n t)) -> + forall (A : Set) (r : mu2 A), P A r. +Axiom mu2Ind : mu2IndType. + +End LNMIt_Type. + +(** BushDepPredShort.v Version 0.2 July 2008 *) +(** does not need impredicative Set, produces stack overflow under V8.2, tested +with SVN 11296 *) + +(** Copyright Ralph Matthes, I.R.I.T., C.N.R.S. & University of Toulouse *) + +Set Implicit Arguments. + +Require Import List. + +Definition listk1 (A:Set) : Set := list A. +Open Scope type_scope. + +Definition BushF(X:k1)(A:Set) := unit + A * X (X A). + +Definition bushpEFct : pEFct BushF. +Proof. + unfold BushF. + apply sumpEFct. + apply constpEFct. + apply constEFct. + apply prodpEFct. + apply constpEFct. + apply idEFct. + apply comppEFct. + apply idpEFct. + apply idpEFct_eta. +Defined. + +Module Type BUSH := LNMIt_Type with Definition F:=BushF + with Definition FpEFct := +bushpEFct. + +Module Bush (BushBase:BUSH). + +Definition Bush : k1 := BushBase.mu2. + +Definition bush : mon Bush := BushBase.mapmu2. + +End Bush. + + +Definition Id : k1 := fun X => X. + +Fixpoint Pow (X:k1)(k:nat){struct k}:k1:= + match k with 0 => Id + | S k' => fun A => X (Pow X k' A) + end. + +Fixpoint POW (k:nat)(X:k1)(m:mon X){struct k} : mon (Pow X k) := + match k return mon (Pow X k) + with 0 => fun _ _ f => f + | S k' => fun _ _ f => m _ _ (POW k' m f) + end. + +Module Type BushkToList_Type. + +Declare Module Import BP: BUSH. +Definition F:=BushF. +Definition FpEFct:= bushpEFct. +Definition mu20 := mu20. +Definition mu2 := mu2. +Definition mapmu2 := mapmu2. +Definition MItType:= MItType. +Definition MIt0 := MIt0. +Definition MIt := MIt. +Definition InType := InType. +Definition In := In. +Definition mapmu2Red:=mapmu2Red. +Definition MItRed:=MItRed. +Definition mu2IndType:=mu2IndType. +Definition mu2Ind:=mu2Ind. + +Definition Bush:= mu2. +Module BushM := Bush BP. + +Parameter BushkToList: forall(k:nat)(A:k0)(t:Pow Bush k A), list A. +Axiom BushkToList0: forall(A:k0)(t:Pow Bush 0 A), BushkToList 0 A t = t::nil. + +End BushkToList_Type. + +Module BushDep (BushkToListM:BushkToList_Type). + +Module Bush := Bush BushkToListM. + +Import Bush. +Import BushkToListM. + + +Lemma BushkToList0NAT: NAT(Y:=listk1) (BushkToList 0) (POW 0 bush) map. +Proof. + red. + intros. + simpl. + rewrite BushkToList0. +(* stack overflow for coqc and coqtop *) + + +Abort. diff --git a/test-suite/bugs/closed/bug_1925.v b/test-suite/bugs/closed/bug_1925.v new file mode 100644 index 0000000000..4caee1c36d --- /dev/null +++ b/test-suite/bugs/closed/bug_1925.v @@ -0,0 +1,22 @@ +(* Check that the analysis of projectable rel's in an evar instance is up to + aliases *) + +Require Import List. + +Definition compose (A B C : Type) (g : B -> C) (f : A -> B) : A -> C := + fun x : A => g(f x). + +Definition map_fuse' : + forall (A B C : Type) (g : B -> C) (f : A -> B) (xs : list A), + (map g (map f xs)) = map (compose _ _ _ g f) xs + := + fun A B C g f => + (fix loop (ys : list A) {struct ys} := + match ys as ys return (map g (map f ys)) = map (compose _ _ _ g f) ys + with + | nil => refl_equal nil + | x :: xs => + match loop xs in eq _ a return eq _ ((g (f x)) :: a) with + | refl_equal => refl_equal (map g (map f (x :: xs))) + end + end). diff --git a/test-suite/bugs/closed/bug_1931.v b/test-suite/bugs/closed/bug_1931.v new file mode 100644 index 0000000000..930ace1d55 --- /dev/null +++ b/test-suite/bugs/closed/bug_1931.v @@ -0,0 +1,29 @@ + + +Set Implicit Arguments. + +Inductive T (A:Set) : Set := + app : T A -> T A -> T A. + +Fixpoint map (A B:Set)(f:A->B)(t:T A) : T B := + match t with + app t1 t2 => app (map f t1)(map f t2) + end. + +Fixpoint subst (A B:Set)(f:A -> T B)(t:T A) :T B := + match t with + app t1 t2 => app (subst f t1)(subst f t2) + end. + +(* This is the culprit: *) +Definition k0:=Set. + +(** interaction of subst with map *) +Lemma substLaw1 (A:k0)(B C:Set)(f: A -> B)(g:B -> T C)(t: T A): + subst g (map f t) = subst (fun x => g (f x)) t. +Proof. + intros. + generalize B C f g; clear B C f g. + induction t; intros; simpl. + f_equal. +Admitted. diff --git a/test-suite/bugs/closed/bug_1935.v b/test-suite/bugs/closed/bug_1935.v new file mode 100644 index 0000000000..d583761985 --- /dev/null +++ b/test-suite/bugs/closed/bug_1935.v @@ -0,0 +1,21 @@ +Definition f (n:nat) := n = n. + +Lemma f_refl : forall n , f n. +intros. reflexivity. +Qed. + +Definition f' (x:nat) (n:nat) := n = n. + +Lemma f_refl' : forall n , f' n n. +Proof. + intros. reflexivity. +Qed. + +Require Import ZArith. + +Definition f'' (a:bool) := if a then eq (A:= Z) else Z.lt. + +Lemma f_refl'' : forall n , f'' true n n. +Proof. + intro. reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_1939.v b/test-suite/bugs/closed/bug_1939.v new file mode 100644 index 0000000000..7b430ace5e --- /dev/null +++ b/test-suite/bugs/closed/bug_1939.v @@ -0,0 +1,19 @@ +Require Import Setoid Program.Basics. + + Parameter P : nat -> Prop. + Parameter R : nat -> nat -> Prop. + + Add Parametric Morphism : P + with signature R ++> impl as PM1. + Admitted. + + Add Parametric Morphism : P + with signature R --> impl as PM2. + Admitted. + + Goal forall x y, R x y -> P y -> P x. + Proof. + intros x y H1 H2. + rewrite H1. + auto. + Qed. diff --git a/test-suite/bugs/closed/bug_1944.v b/test-suite/bugs/closed/bug_1944.v new file mode 100644 index 0000000000..ee2918c6e9 --- /dev/null +++ b/test-suite/bugs/closed/bug_1944.v @@ -0,0 +1,9 @@ +(* Test some uses of ? in introduction patterns *) + +Inductive J : nat -> Prop := + | K : forall p, J p -> (True /\ True) -> J (S p). + +Lemma bug : forall n, J n -> J (S n). +Proof. + intros ? H. + induction H as [? ? [? ?]]. diff --git a/test-suite/bugs/closed/bug_1951.v b/test-suite/bugs/closed/bug_1951.v new file mode 100644 index 0000000000..e950554c4b --- /dev/null +++ b/test-suite/bugs/closed/bug_1951.v @@ -0,0 +1,63 @@ + +(* First a simplification of the bug *) + +Set Printing Universes. + +Inductive enc (A:Type (*1*)) (* : Type.1 *) := C : A -> enc A. + +Definition id (X:Type(*4*)) (x:X) := x. + +Lemma test : let S := Type(*5 : 6*) in enc S -> S. +simpl; intros. +refine (enc _). +apply id. +apply Prop. +Defined. + +(* Then the original bug *) + +Require Import List. + +Inductive a : Set := (* some dummy inductive *) +b : (list a) -> a. (* i don't know if this *) + (* happens for smaller *) + (* ones *) + +Inductive sg : Type := Sg. (* single *) + +Definition ipl2 (P : a -> Type) := (* in Prop, that means P is true forall *) + fold_right (fun x => fun A => prod (P x) A) sg. (* the elements of a given list *) + +Definition ind + : forall S : a -> Type, + (forall ls : list a, ipl2 S ls -> S (b ls)) -> forall s : a, S s := +fun (S : a -> Type) + (X : forall ls : list a, ipl2 S ls -> S (b ls)) => +fix ind2 (s : a) := +match s as a return (S a) with +| b l => + X l + (list_rect (fun l0 : list a => ipl2 S l0) Sg + (fun (a0 : a) (l0 : list a) (IHl : ipl2 S l0) => + pair (ind2 a0) IHl) l) +end. (* some induction principle *) + +Arguments ind [S]. + +Lemma k : a -> Type. (* some ininteresting lemma *) +intro;pattern H;apply ind;intros. + assert (K : Type). + induction ls. + exact sg. + exact sg. + exact (prod K sg). +Defined. + +Lemma k' : a -> Type. (* same lemma but with our bug *) +intro;pattern H;apply ind;intros. + refine (prod _ _). + induction ls. + exact sg. + exact sg. + exact sg. (* Proof complete *) +Defined. (* bug *) diff --git a/test-suite/bugs/closed/bug_1962.v b/test-suite/bugs/closed/bug_1962.v new file mode 100644 index 0000000000..37b0dde06d --- /dev/null +++ b/test-suite/bugs/closed/bug_1962.v @@ -0,0 +1,55 @@ +(* Bug 1962.v + +Bonjour, + +J'ai un exemple de lemme que j'arrivais à prouver avec fsetdec avec la 8.2beta3 +avec la beta4 et la version svn 11447 branche 8.2 çà diverge. + +Voici l'exemple en question, l'exmple test2 marche bien dans les deux version, +test en revanche pose probleme: + +*) + +Require Export FSets. + +(** This module takes a decidable type and +build finite sets of this type, tactics and defs *) + +Module BuildFSets (DecPoints: UsualDecidableType). + +Module Export FiniteSetsOfPoints := FSetWeakList.Make DecPoints. +Module Export FiniteSetsOfPointsProperties := + WProperties FiniteSetsOfPoints. +Module Export Dec := WDecide FiniteSetsOfPoints. +Module Export FM := Dec.F. + +Definition set_of_points := t. +Definition Point := DecPoints.t. + +Definition couple(x y :Point) : set_of_points := +add x (add y empty). + +Definition triple(x y t :Point): set_of_points := +add x (add y (add t empty)). + +Lemma test : forall P A B C A' B' C', +Equal +(union (singleton P) (union (triple A B C) (triple A' B' C'))) +(union (triple P B B') (union (couple P A) (triple C A' C'))). +Proof. +intros. +unfold triple, couple. +Time fsetdec. (* works in 8.2 beta 3, not in beta 4 and final 8.2 *) + (* appears to works again in 8.3 and trunk, take 4-6 seconds *) +Qed. + +Lemma test2 : forall A B C, +Equal + (union (singleton C) (couple A B)) (triple A B C). +Proof. +intros. +unfold triple, couple. +Time fsetdec. +Qed. + +End BuildFSets. diff --git a/test-suite/bugs/closed/bug_1963.v b/test-suite/bugs/closed/bug_1963.v new file mode 100644 index 0000000000..11e2ee44d6 --- /dev/null +++ b/test-suite/bugs/closed/bug_1963.v @@ -0,0 +1,19 @@ +(* Check that "dependent inversion" behaves correctly w.r.t to universes *) + +Require Import Eqdep. + +Set Implicit Arguments. + +Inductive illist(A:Type) : nat -> Type := + illistn : illist A 0 +| illistc : forall n:nat, A -> illist A n -> illist A (S n). + +Inductive isig (A:Type)(P:A -> Type) : Type := + iexists : forall x : A, P x -> isig P. + +Lemma inv : forall (A:Type)(n n':nat)(ts':illist A n'), n' = S n -> + isig (fun t => isig (fun ts => + eq_dep nat (fun n => illist A n) n' ts' (S n) (illistc t ts))). +Proof. +intros. +dependent inversion ts'. diff --git a/test-suite/bugs/closed/bug_1977.v b/test-suite/bugs/closed/bug_1977.v new file mode 100644 index 0000000000..28715040ce --- /dev/null +++ b/test-suite/bugs/closed/bug_1977.v @@ -0,0 +1,4 @@ +Inductive T {A} : Prop := c : A -> T. +Goal (@T nat). +apply c. exact 0. +Qed. diff --git a/test-suite/bugs/closed/bug_1981.v b/test-suite/bugs/closed/bug_1981.v new file mode 100644 index 0000000000..a3d9429307 --- /dev/null +++ b/test-suite/bugs/closed/bug_1981.v @@ -0,0 +1,5 @@ +Arguments ex_intro [A]. + +Goal exists n : nat, True. + eapply ex_intro. exact 0. exact I. +Qed. diff --git a/test-suite/bugs/closed/bug_2001.v b/test-suite/bugs/closed/bug_2001.v new file mode 100644 index 0000000000..652c65706a --- /dev/null +++ b/test-suite/bugs/closed/bug_2001.v @@ -0,0 +1,22 @@ +(* Automatic computing of guard in "Theorem with"; check that guard is not + computed when the user explicitly indicated it *) + +Unset Automatic Introduction. + +Inductive T : Set := +| v : T. + +Definition f (s:nat) (t:T) : nat. +fix f 2. +intros s t. +refine + match t with + | v => s + end. +Defined. + +Lemma test : + forall s, f s v = s. +Proof. +reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_2006.v b/test-suite/bugs/closed/bug_2006.v new file mode 100644 index 0000000000..d353d0e2d6 --- /dev/null +++ b/test-suite/bugs/closed/bug_2006.v @@ -0,0 +1,23 @@ +(* Take the type constraint on Record into account *) + +Definition Type1 := Type. +Fail Record R : Type1 := { p:Type1 }. (* was accepted before trunk revision 11619 *) + +(* +Remarks: + +- The behaviour was inconsistent with the one of Inductive, e.g. + + Inductive R : Type1 := Build_R : Type1 -> R. + + was correctly refused. + +- CoRN makes some use of the following configuration: + + Definition CProp := Type. + Record R : CProp := { ... }. + + CoRN may have to change the CProp definition into a notation if the + preservation of the former semantics of Record type constraints + turns to be required. +*) diff --git a/test-suite/bugs/closed/bug_2016.v b/test-suite/bugs/closed/bug_2016.v new file mode 100644 index 0000000000..927021a259 --- /dev/null +++ b/test-suite/bugs/closed/bug_2016.v @@ -0,0 +1,64 @@ +(* Coq 8.2beta4 *) +Require Import Classical_Prop. + +Unset Structural Injection. + +Record coreSemantics : Type := CoreSemantics { + core: Type; + corestep: core -> core -> Prop; + corestep_fun: forall q q1 q2, corestep q q1 -> corestep q q2 -> q1 = q2 +}. + +Definition state : Type := {sem: coreSemantics & sem.(core)}. + +Inductive step: state -> state -> Prop := + | step_core: forall sem st st' + (Hcs: sem.(corestep) st st'), + step (existT _ sem st) (existT _ sem st'). + +Lemma step_fun: forall st1 st2 st2', step st1 st2 -> step st1 st2' -> st2 = st2'. +Proof. +intros. +inversion H; clear H; subst. inversion H0; clear H0; subst; auto. +generalize (inj_pairT2 _ _ _ _ _ H2); clear H2; intro; subst. +rewrite (corestep_fun _ _ _ _ Hcs Hcs0); auto. +Qed. + +Record oe_core := oe_Core { + in_core: Type; + in_corestep: in_core -> in_core -> Prop; + in_corestep_fun: forall q q1 q2, in_corestep q q1 -> in_corestep q q2 -> q1 = q2; + in_q: in_core +}. + +Definition oe2coreSem (oec : oe_core) : coreSemantics := + CoreSemantics oec.(in_core) oec.(in_corestep) oec.(in_corestep_fun). + +Definition oe_corestep (q q': oe_core) := + step (existT _ (oe2coreSem q) q.(in_q)) (existT _ (oe2coreSem q') q'.(in_q)). + +Lemma inj_pairT1: forall (U: Type) (P: U -> Type) (p1 p2: U) x y, + existT P p1 x = existT P p2 y -> p1=p2. +Proof. intros; injection H; auto. +Qed. + +Definition f := CoreSemantics oe_core. + +Lemma oe_corestep_fun: forall q q1 q2, + oe_corestep q q1 -> oe_corestep q q2 -> q1 = q2. +Proof. +unfold oe_corestep; intros. +assert (HH:= step_fun _ _ _ H H0); clear H H0. +destruct q1; destruct q2; unfold oe2coreSem; simpl in *. +generalize (inj_pairT1 _ _ _ _ _ _ HH); clear HH; intros. +injection H. +revert in_q1 in_corestep1 in_corestep_fun1 + H. +pattern in_core1. +apply eq_ind_r with (x := in_core0). +admit. +apply sym_eq. +(** good to here **) +Show Universes. +Print Universes. +Fail apply H0. diff --git a/test-suite/bugs/closed/bug_2017.v b/test-suite/bugs/closed/bug_2017.v new file mode 100644 index 0000000000..df6661483a --- /dev/null +++ b/test-suite/bugs/closed/bug_2017.v @@ -0,0 +1,15 @@ +(* Some check of Miller's pattern inference - used to fail in 8.2 due + first to the presence of aliases, secondly due to the absence of + restriction of the potential interesting variables to the subset of + variables effectively occurring in the term to instantiate *) + +Set Implicit Arguments. + +Variable choose : forall(P : bool -> Prop)(H : exists x, P x), bool. + +Variable H : exists x : bool, True. + +Definition coef := +match Some true with + Some _ => @choose _ H |_ => true +end . diff --git a/test-suite/bugs/closed/bug_2021.v b/test-suite/bugs/closed/bug_2021.v new file mode 100644 index 0000000000..5df92998e1 --- /dev/null +++ b/test-suite/bugs/closed/bug_2021.v @@ -0,0 +1,25 @@ +(* correct failure of injection/discriminate on types whose inductive + status derives from the substitution of an argument *) + +Unset Structural Injection. + +Inductive t : nat -> Type := +| M : forall n: nat, nat -> t n. + +Lemma eq_t : forall n n' m m', + existT (fun B : Type => B) (t n) (M n m) = + existT (fun B : Type => B) (t n') (M n' m') -> True. +Proof. + intros. + injection H. + intro Ht. + exact I. +Qed. + +Lemma eq_t' : forall n n' : nat, + existT (fun B : Type => B) (t n) (M n 0) = + existT (fun B : Type => B) (t n') (M n' 1) -> True. +Proof. + intros. + discriminate H || exact I. +Qed. diff --git a/test-suite/bugs/closed/bug_2027.v b/test-suite/bugs/closed/bug_2027.v new file mode 100644 index 0000000000..ebc2bc070c --- /dev/null +++ b/test-suite/bugs/closed/bug_2027.v @@ -0,0 +1,11 @@ + +Parameter T : Type -> Type. +Parameter f : forall {A}, T A -> T A. +Parameter P : forall {A}, T A -> Prop. +Axiom f_id : forall {A} (l : T A), f l = l. + +Goal forall A (p : T A), P p. +Proof. + intros. + rewrite <- f_id. +Admitted. diff --git a/test-suite/bugs/closed/bug_2083.v b/test-suite/bugs/closed/bug_2083.v new file mode 100644 index 0000000000..f33e96cea6 --- /dev/null +++ b/test-suite/bugs/closed/bug_2083.v @@ -0,0 +1,27 @@ +Require Import Program Arith. + +Program Fixpoint check_n (n : nat) (P : { i | i < n } -> bool) (p : nat) + (H : forall (i : { i | i < n }), i < p -> P i = true) + {measure (n - p)} : + Exc (forall (p : { i | i < n}), P p = true) := + match le_lt_dec n p with + | left _ => value _ + | right cmp => + if dec (P p) then + check_n n P (S p) _ + else + error + end. + +Require Import Omega. + +Solve Obligations with program_simpl ; auto with *; try omega. + +Next Obligation. + apply H. simpl. omega. +Defined. + +Next Obligation. + case (le_lt_dec p i) ; intros. assert(i = p) by omega. subst. + revert H0. clear_subset_proofs. auto. + apply H. simpl. assumption. Defined. diff --git a/test-suite/bugs/closed/bug_2089.v b/test-suite/bugs/closed/bug_2089.v new file mode 100644 index 0000000000..aebccc9424 --- /dev/null +++ b/test-suite/bugs/closed/bug_2089.v @@ -0,0 +1,17 @@ +Inductive even (x: nat): nat -> Prop := + | even_base: even x O + | even_succ: forall n, odd x n -> even x (S n) + +with odd (x: nat): nat -> Prop := + | odd_succ: forall n, even x n -> odd x (S n). + +Scheme even_ind2 := Minimality for even Sort Prop + with odd_ind2 := Minimality for odd Sort Prop. + +Combined Scheme even_odd_ind from even_ind2, odd_ind2. + +Check (even_odd_ind :forall (x : nat) (P P0 : nat -> Prop), + P 0 -> + (forall n : nat, odd x n -> P0 n -> P (S n)) -> + (forall n : nat, even x n -> P n -> P0 (S n)) -> + (forall n : nat, even x n -> P n) /\ (forall n : nat, odd x n -> P0 n)). diff --git a/test-suite/bugs/closed/bug_2095.v b/test-suite/bugs/closed/bug_2095.v new file mode 100644 index 0000000000..28ea99dfef --- /dev/null +++ b/test-suite/bugs/closed/bug_2095.v @@ -0,0 +1,19 @@ +(* Classes and sections *) + +Section OPT. + Variable A: Type. + + Inductive MyOption: Type := + | MyNone: MyOption + | MySome: A -> MyOption. + + Class Opt: Type := { + f_opt: A -> MyOption + }. +End OPT. + +Definition f_nat (n: nat): MyOption nat := MySome _ n. + +Instance Nat_Opt: Opt nat := { + f_opt := f_nat +}. diff --git a/test-suite/bugs/closed/bug_2105.v b/test-suite/bugs/closed/bug_2105.v new file mode 100644 index 0000000000..46a416fd4b --- /dev/null +++ b/test-suite/bugs/closed/bug_2105.v @@ -0,0 +1,2 @@ + +Definition id (T:Type) := Eval vm_compute in T. diff --git a/test-suite/bugs/closed/bug_2108.v b/test-suite/bugs/closed/bug_2108.v new file mode 100644 index 0000000000..cad8baa981 --- /dev/null +++ b/test-suite/bugs/closed/bug_2108.v @@ -0,0 +1,22 @@ +(* Declare Module in Module Type *) +Module Type A. +Record t : Set := { something : unit }. +End A. + + +Module Type B. +Declare Module BA : A. +End B. + + +Module Type C. +Declare Module CA : A. +Declare Module CB : B with Module BA := CA. +End C. + + +Module Type D. +Declare Module DA : A. +(* Next line gives: "Anomaly: uncaught exception Not_found. Please report." *) +Declare Module DC : C with Module CA := DA. +End D. diff --git a/test-suite/bugs/closed/bug_2117.v b/test-suite/bugs/closed/bug_2117.v new file mode 100644 index 0000000000..50c925617e --- /dev/null +++ b/test-suite/bugs/closed/bug_2117.v @@ -0,0 +1,56 @@ +(* Check pattern-unification on evars in apply unification *) + +Axiom app : forall tau tau':Type, (tau -> tau') -> tau -> tau'. + +Axiom copy : forall tau:Type, tau -> tau -> Prop. +Axiom copyr : forall tau:Type, tau -> tau -> Prop. +Axiom copyf : forall tau:Type, tau -> tau -> Prop. +Axiom eq : forall tau:Type, tau -> tau -> Prop. +Axiom subst : forall tau tau':Type, (tau -> tau') -> tau -> tau' -> Prop. + +Axiom copy_atom : forall tau:Type, forall t t':tau, eq tau t t' -> copy tau t t'. +Axiom copy_fun: forall tau tau':Type, forall t t':(tau->tau'), +(forall x:tau, copyr tau x x->copy tau' (t x) (t' x)) +->copy (tau->tau') t t'. + +Axiom copyr_atom : forall tau:Type, forall t t':tau, copyr tau t t' -> eq tau t t'. +Axiom copyr_fun: forall tau tau':Type, forall t t':(tau->tau'), +copyr (tau->tau') t t' +->(forall x y:tau, copy tau x y->copyr tau' (t x) (t' y)). + +Axiom copyf_atom : forall tau:Type, forall t t':tau, copyf tau t t' -> eq tau t t'. +Axiom copyf_fun: forall tau tau':Type, forall t t':(tau->tau'), +copyr (tau->tau') t t' +->(forall x y:tau, forall z1 z2:tau', +(copy tau x y)-> +(subst tau tau' t x z1)-> +(subst tau tau' t' y z2)-> +copyf tau' z1 z2). + +Axiom eqappg: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau',forall t':tau', +( ((subst tau tau' t q t') /\ (eq tau' t' r)) +->eq tau' (app tau tau' t q) r). + +Axiom eqappd: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau', +forall t':tau', ((subst tau tau' t q t') /\ (eq tau' r t')) +->eq tau' r (app tau tau' t q). + +Axiom substcopy: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau', +(forall x:tau, (copyf tau x q) -> (copy tau' (t x) r)) +->subst tau tau' t q r. + +Ltac EtaLong := (apply copy_fun;intros;EtaLong)|| apply copy_atom. +Ltac Subst := apply substcopy;intros;EtaLong. +Ltac Rigid_aux := fun A => apply A|| Rigid_aux (copyr_fun _ _ _ _ A). +Ltac Rigid := fun A => apply copyr_atom; Rigid_aux A. + +Theorem church0: forall i:Type, exists X:(i->i)->i->i, +copy ((i->i)->i->i) (fun f:i->i => fun x:i=>f (X f x)) (fun f:i->i=>fun x:i=>app i i (X f) (f x)). +intros. +esplit. +EtaLong. +eapply eqappd;split. +Subst. +apply copyf_atom. +Show Existentials. +apply H1. diff --git a/test-suite/bugs/closed/bug_2123.v b/test-suite/bugs/closed/bug_2123.v new file mode 100644 index 0000000000..2957e53e3c --- /dev/null +++ b/test-suite/bugs/closed/bug_2123.v @@ -0,0 +1,9 @@ +(* About the detection of non-dependent metas by the refine tactic *) + +(* The following is a simplification of bug #2123 *) + +Parameter fset : nat -> Set. +Parameter widen : forall (n : nat) (s : fset n), { x : fset (S n) | s=s }. +Goal forall i, fset (S i). +intro. +refine (proj1_sig (widen i _)). diff --git a/test-suite/bugs/closed/bug_2127.v b/test-suite/bugs/closed/bug_2127.v new file mode 100644 index 0000000000..142ada268b --- /dev/null +++ b/test-suite/bugs/closed/bug_2127.v @@ -0,0 +1,8 @@ +(* Check that "apply eq_refl" is not exported as an interactive + tactic but as a statically globalized one *) + +(* (this is a simplification of the original bug report) *) + +Module A. +Hint Rewrite eq_sym using apply eq_refl : foo. +End A. diff --git a/test-suite/bugs/closed/bug_2135.v b/test-suite/bugs/closed/bug_2135.v new file mode 100644 index 0000000000..1638214e96 --- /dev/null +++ b/test-suite/bugs/closed/bug_2135.v @@ -0,0 +1,9 @@ +(* Check that metas are whd-normalized before trying 2nd-order unification *) +Lemma test : + forall (D:Type) (T : forall C, option C) (Q:forall D, option D -> Prop), + (forall (A : Type) (P : forall B:Type, option B -> Prop), P A (T A)) + -> Q D (T D). +Proof. + intros D T Q H. + pattern (T D). apply H. +Qed. diff --git a/test-suite/bugs/closed/bug_2136.v b/test-suite/bugs/closed/bug_2136.v new file mode 100644 index 0000000000..2fcfbe40dc --- /dev/null +++ b/test-suite/bugs/closed/bug_2136.v @@ -0,0 +1,61 @@ +(* Bug #2136 + +The fsetdec tactic seems to get confused by hypotheses like + HeqH1 : H1 = MkEquality s0 s1 b +If I clear them then it is able to solve my goal; otherwise it is not. +I would expect it to be able to solve the goal even without this hypothesis +being cleared. A small, self-contained example is below. + +I have coq r12238. + + +Thanks +Ian +*) + + +Require Import FSets. +Require Import Arith. +Require Import FSetWeakList. + +Module DecidableNat. +Definition t := nat. +Definition eq := @eq nat. +Definition eq_refl := @refl_equal nat. +Definition eq_sym := @sym_eq nat. +Definition eq_trans := @trans_eq nat. +Definition eq_dec := eq_nat_dec. +End DecidableNat. + +Module NatSet := Make(DecidableNat). + +Module Export Dec := WDecide (NatSet). +Import FSetDecideAuxiliary. + +Parameter MkEquality : forall ( s0 s1 : NatSet.t ) + ( x : nat ), + NatSet.Equal s1 (NatSet.add x s0). + +Lemma ThisLemmaWorks : forall ( s0 s1 : NatSet.t ) + ( a b : nat ), + NatSet.In a s0 + -> NatSet.In a s1. +Proof. +intros. +remember (MkEquality s0 s1 b) as H1. +clear HeqH1. +fsetdec. +Qed. + +Lemma ThisLemmaWasFailing : forall ( s0 s1 : NatSet.t ) + ( a b : nat ), + NatSet.In a s0 + -> NatSet.In a s1. +Proof. +intros. +remember (MkEquality s0 s1 b) as H1. +fsetdec. +(* +Error: Tactic failure: because the goal is beyond the scope of this tactic. +*) +Qed. diff --git a/test-suite/bugs/closed/bug_2137.v b/test-suite/bugs/closed/bug_2137.v new file mode 100644 index 0000000000..b1f54b1766 --- /dev/null +++ b/test-suite/bugs/closed/bug_2137.v @@ -0,0 +1,52 @@ +(* Bug #2137 + +The fsetdec tactic is sensitive to which way round the arguments to <> are. +In the small, self-contained example below, it is able to solve the goal +if it knows that "b <> a", but not if it knows that "a <> b". I would expect +it to be able to solve hte goal in either case. + +I have coq r12238. + + +Thanks +Ian + +*) + +Require Import Arith FSets FSetWeakList. + +Module DecidableNat. +Definition t := nat. +Definition eq := @eq nat. +Definition eq_refl := @refl_equal nat. +Definition eq_sym := @sym_eq nat. +Definition eq_trans := @trans_eq nat. +Definition eq_dec := eq_nat_dec. +End DecidableNat. + +Module NatSet := Make(DecidableNat). + +Module Export NameSetDec := WDecide (NatSet). + +Lemma ThisLemmaWorks : forall ( s0 : NatSet.t ) + ( a b : nat ), + b <> a + -> ~(NatSet.In a s0) + -> ~(NatSet.In a (NatSet.add b s0)). +Proof. +intros. +fsetdec. +Qed. + +Lemma ThisLemmaWasFailing : forall ( s0 : NatSet.t ) + ( a b : nat ), + a <> b + -> ~(NatSet.In a s0) + -> ~(NatSet.In a (NatSet.add b s0)). +Proof. +intros. +fsetdec. +(* +Error: Tactic failure: because the goal is beyond the scope of this tactic. +*) +Qed. diff --git a/test-suite/bugs/closed/bug_2139.v b/test-suite/bugs/closed/bug_2139.v new file mode 100644 index 0000000000..e2e4784965 --- /dev/null +++ b/test-suite/bugs/closed/bug_2139.v @@ -0,0 +1,24 @@ +(* Call of apply on <-> failed because of evars in elimination predicate *) +Generalizable Variables patch. + +Class Patch (patch : Type) := { + commute : patch -> patch -> Prop +}. + +Parameter flip : forall `{patchInstance : Patch patch} + {a b : patch}, + commute a b <-> commute b a. + +Lemma Foo : forall `{patchInstance : Patch patch} + {a b : patch}, + (commute a b) + -> True. +Proof. +intros. +apply flip in H. + +(* failed in well-formed arity check because elimination predicate of + iff in (@flip _ _ _ _) had normalized evars while the ones in the + type of (@flip _ _ _ _) itself had non-normalized evars *) + +(* By the way, is the check necessary ? *) diff --git a/test-suite/bugs/closed/bug_2141.v b/test-suite/bugs/closed/bug_2141.v new file mode 100644 index 0000000000..22e33c8e81 --- /dev/null +++ b/test-suite/bugs/closed/bug_2141.v @@ -0,0 +1,16 @@ +Require Coq.extraction.Extraction. +Require Import FSetList. +Require Import OrderedTypeEx. + +Module NatSet := FSetList.Make (Nat_as_OT). +Recursive Extraction NatSet.fold. + +Module FSetHide (X : FSetInterface.S). + Include X. +End FSetHide. + +Module NatSet' := FSetHide NatSet. +Recursive Extraction NatSet'.fold. +Extraction TestCompile NatSet'.fold. + +(* Extraction "test2141.ml" NatSet'.fold. *) diff --git a/test-suite/bugs/closed/bug_2145.v b/test-suite/bugs/closed/bug_2145.v new file mode 100644 index 0000000000..949fc20364 --- /dev/null +++ b/test-suite/bugs/closed/bug_2145.v @@ -0,0 +1,19 @@ +(* Test robustness of Groebner tactic in presence of disequalities *) + +Require Export Reals. +Require Export Nsatz. + +Open Scope R_scope. + +Lemma essai : + forall yb xb m1 m2 xa ya, + xa <> xb -> + yb - 2 * m2 * xb = ya - m2 * xa -> + yb - m1 * xb = ya - m1 * xa -> + yb - ya = (2 * xb - xa) * m2 -> + yb - ya = (xb - xa) * m1. +Proof. +intros. +(* clear H. groebner used not to work when H was not cleared *) +nsatz. +Qed. diff --git a/test-suite/bugs/closed/bug_2149.v b/test-suite/bugs/closed/bug_2149.v new file mode 100644 index 0000000000..8bc5a2cefc --- /dev/null +++ b/test-suite/bugs/closed/bug_2149.v @@ -0,0 +1,6 @@ +Lemma Foo : forall x y : nat, y = x -> y = x. +Proof. +intros x y. +rename x into y, y into x. +trivial. +Qed. diff --git a/test-suite/bugs/closed/bug_2164.v b/test-suite/bugs/closed/bug_2164.v new file mode 100644 index 0000000000..6adb3577be --- /dev/null +++ b/test-suite/bugs/closed/bug_2164.v @@ -0,0 +1,334 @@ +(* Check that "inversion as" manages names as expected *) +Inductive type: Set + := | int: type + | pointer: type -> type. +Print type. + +Parameter value_set + : type -> Set. + +Parameter string : Set. + +Parameter Z : Set. + +Inductive lvalue (t: type): Set + := | var: string -> lvalue t (* name of the variable *) + | lvalue_loc: Z -> lvalue t (* address of the variable *) + | deref_l: lvalue (pointer t) -> lvalue t (* deref an lvalue ptr *) + | deref_r: rvalue (pointer t) -> lvalue t (* deref an rvalue ptr *) +with rvalue (t: type): Set + := | value_of: lvalue t -> rvalue t (* variable as value *) + | mk_rvalue: value_set t -> rvalue t. (* literal value *) +Print lvalue. + +Inductive statement: Set + := | void_stat: statement + | var_loc: (* to be destucted at end of scope *) + forall (t: type) (n: string) (loc: Z), statement + | var_ref: (* not to be destructed *) + forall (t: type) (n: string) (loc: Z), statement + | var_def: (* var def as typed in code *) + forall (t:type) (n: string) (val: rvalue t), statement + | assign: + forall (t: type) (var: lvalue t) (val: rvalue t), statement + | group: + forall (l: list statement), statement + | fun_def: + forall (s: string) (l: list statement), statement + | param_decl: + forall (t: type) (n: string), statement + | delete: + forall a: Z, statement. + +Inductive expr: Set +:= | statement_to_expr: statement -> expr + | lvalue_to_expr: forall t: type, lvalue t -> expr + | rvalue_to_expr: forall t: type, rvalue t -> expr. + +Inductive executable_prim_expr: expr -> Set +:= +(* statements *) + | var_def_primitive: + forall (t: type) (n: string) (loc: Z), + executable_prim_expr + (statement_to_expr + (var_def t n + (value_of t (lvalue_loc t loc)))) + | assign_primitive: + forall (t: type) (loc1 loc2: Z), + executable_prim_expr + (statement_to_expr + (assign t (lvalue_loc t loc1) + (value_of t (lvalue_loc t loc2)))) +(* rvalue *) + | mk_rvalue_primitive: + forall (t: type) (v: value_set t), + executable_prim_expr + (rvalue_to_expr t (mk_rvalue t v)) +(* lvalue *) + (* var *) + | var_primitive: + forall (t: type) (n: string), + executable_prim_expr (lvalue_to_expr t (var t n)) + (* deref_l *) + | deref_l_primitive: + forall (t: type) (loc: Z), + executable_prim_expr + (lvalue_to_expr t + (deref_l t (lvalue_loc (pointer t) loc))) + (* deref_r *) + | deref_r_primitive: + forall (t: type) (loc: Z), + executable_prim_expr + (lvalue_to_expr t + (deref_r t + (value_of (pointer t) + (lvalue_loc (pointer t) loc)))). + +Inductive executable_sub_expr: expr -> Set +:= | executable_sub_expr_prim: + forall e: expr, + executable_prim_expr e -> + executable_sub_expr e +(* statements *) + | var_def_sub_rvalue: + forall (t: type) (n: string) (rv: rvalue t), + executable_sub_expr (rvalue_to_expr t rv) -> + executable_sub_expr (statement_to_expr (var_def t n rv)) + | assign_sub_lvalue: + forall (t: type) (lv: lvalue t) (rv: rvalue t), + executable_sub_expr (lvalue_to_expr t lv) -> + executable_sub_expr (statement_to_expr (assign t lv rv)) + | assign_sub_rvalue: + forall (t: type) (lv: lvalue t) (rv: rvalue t), + executable_sub_expr (rvalue_to_expr t rv) -> + executable_sub_expr (statement_to_expr (assign t lv rv)) +(* rvalue *) + | value_of_sub_lvalue: + forall (t: type) (lv: lvalue t), + executable_sub_expr (lvalue_to_expr t lv) -> + executable_sub_expr (rvalue_to_expr t (value_of t lv)) +(* lvalue *) + | deref_l_sub_lvalue: + forall (t: type) (lv: lvalue (pointer t)), + executable_sub_expr (lvalue_to_expr (pointer t) lv) -> + executable_sub_expr (lvalue_to_expr t (deref_l t lv)) + | deref_r_sub_rvalue: + forall (t: type) (rv: rvalue (pointer t)), + executable_sub_expr (rvalue_to_expr (pointer t) rv) -> + executable_sub_expr (lvalue_to_expr t (deref_r t rv)). + +Inductive expr_kind: Set +:= | statement_kind: expr_kind + | lvalue_kind: type -> expr_kind + | rvalue_kind: type -> expr_kind. + +Definition expr_to_kind: expr -> expr_kind. +intro e. +destruct e. +exact statement_kind. +exact (lvalue_kind t). +exact (rvalue_kind t). +Defined. + +Inductive def_sub_expr_subs: + forall e: expr, + forall ee: executable_sub_expr e, + forall ee': expr, + forall e': expr, + Prop +:= | def_sub_expr_subs_prim: + forall e: expr, + forall p: executable_prim_expr e, + forall ee': expr, + expr_to_kind e = expr_to_kind ee' -> + def_sub_expr_subs e (executable_sub_expr_prim e p) ee' ee' + | def_sub_expr_subs_var_def_sub_rvalue: + forall (t: type) (n: string), + forall rv rv': rvalue t, + forall ee': expr, + forall se_rv: executable_sub_expr (rvalue_to_expr t rv), + def_sub_expr_subs (rvalue_to_expr t rv) se_rv ee' + (rvalue_to_expr t rv') -> + def_sub_expr_subs + (statement_to_expr (var_def t n rv)) + (var_def_sub_rvalue t n rv se_rv) + ee' + (statement_to_expr (var_def t n rv')) + | def_sub_expr_subs_assign_sub_lvalue: + forall t: type, + forall lv lv': lvalue t, + forall rv: rvalue t, + forall ee': expr, + forall se_lv: executable_sub_expr (lvalue_to_expr t lv), + def_sub_expr_subs (lvalue_to_expr t lv) se_lv ee' + (lvalue_to_expr t lv') -> + def_sub_expr_subs + (statement_to_expr (assign t lv rv)) + (assign_sub_lvalue t lv rv se_lv) + ee' + (statement_to_expr (assign t lv' rv)) + | def_sub_expr_subs_assign_sub_rvalue: + forall t: type, + forall lv: lvalue t, + forall rv rv': rvalue t, + forall ee': expr, + forall se_rv: executable_sub_expr (rvalue_to_expr t rv), + def_sub_expr_subs (rvalue_to_expr t rv) se_rv ee' + (rvalue_to_expr t rv') -> + def_sub_expr_subs + (statement_to_expr (assign t lv rv)) + (assign_sub_rvalue t lv rv se_rv) + ee' + (statement_to_expr (assign t lv rv')) + | def_sub_expr_subs_value_of_sub_lvalue: + forall t: type, + forall lv lv': lvalue t, + forall ee': expr, + forall se_lv: executable_sub_expr (lvalue_to_expr t lv), + def_sub_expr_subs (lvalue_to_expr t lv) se_lv ee' + (lvalue_to_expr t lv') -> + def_sub_expr_subs + (rvalue_to_expr t (value_of t lv)) + (value_of_sub_lvalue t lv se_lv) + ee' + (rvalue_to_expr t (value_of t lv')) + | def_sub_expr_subs_deref_l_sub_lvalue: + forall t: type, + forall lv lv': lvalue (pointer t), + forall ee': expr, + forall se_lv: executable_sub_expr (lvalue_to_expr (pointer t) lv), + def_sub_expr_subs (lvalue_to_expr (pointer t) lv) se_lv ee' + (lvalue_to_expr (pointer t) lv') -> + def_sub_expr_subs + (lvalue_to_expr t (deref_l t lv)) + (deref_l_sub_lvalue t lv se_lv) + ee' + (lvalue_to_expr t (deref_l t lv')) + | def_sub_expr_subs_deref_r_sub_rvalue: + forall t: type, + forall rv rv': rvalue (pointer t), + forall ee': expr, + forall se_rv: executable_sub_expr (rvalue_to_expr (pointer t) rv), + def_sub_expr_subs (rvalue_to_expr (pointer t) rv) se_rv ee' + (rvalue_to_expr (pointer t) rv') -> + def_sub_expr_subs + (lvalue_to_expr t (deref_r t rv)) + (deref_r_sub_rvalue t rv se_rv) + ee' + (lvalue_to_expr t (deref_r t rv')). + +Lemma type_dec: forall t t': type, {t = t'} + {t <> t'}. +Proof. +intros t. +induction t as [|t IH]. +destruct t'. +tauto. +right. +discriminate. +destruct t'. +right. +discriminate. +destruct (IH t') as [H|H]. +left. +f_equal. +tauto. +right. +injection. +tauto. +Qed. +Check type_dec. + +Definition sigT_get_proof: + forall T: Type, + forall eq_dec_T: forall t t': T, {t = t'} + {~ t = t'}, + forall P: T -> Type, + forall t: T, + P t -> + sigT P -> + P t. +intros T eq_dec_T P t H1 H2. +destruct H2 as [t' H2]. +destruct (eq_dec_T t t') as [H3|H3]. +rewrite H3. +exact H2. +exact H1. +Defined. + +Axiom sigT_get_proof_existT_same: + forall T: Type, + forall eq_dec_T: forall t t': T, {t = t'} + {~ t = t'}, + forall P: T -> Type, + forall t: T, + forall H1 H2: P t, + sigT_get_proof T eq_dec_T P t H1 (existT P t H2) = H2. + +Theorem existT_injective: + forall T, + (forall t1 t2: T, { t1 = t2 } + { t1 <> t2 }) -> + forall P: T -> Type, + forall t: T, + forall pt1 pt2: P t, + existT P t pt1 = existT P t pt2 -> + pt1 = pt2. +Proof. +intros T T_dec P t pt1 pt2 H1. +pose (H2 := f_equal (sigT_get_proof T T_dec P t pt1) H1). +repeat rewrite sigT_get_proof_existT_same in H2. +assumption. +Qed. + +Ltac decide_equality_sub dec x x' H := + destruct (dec x x') as [H|H]; + [subst x'; try tauto|try(right; injection; tauto; fail)]. + +Axiom value_set_dec: + forall t: type, + forall v v': value_set t, + {v = v'} + {v <> v'}. + +Theorem lvalue_dec: + forall (t: type) (l l': lvalue t), {l = l'} + {l <> l'} +with rvalue_dec: + forall (t: type) (r r': rvalue t), {r = r'} + {r <> r'}. +Admitted. + +Theorem sub_expr_subs_same_kind: + forall e: expr, + forall ee: executable_sub_expr e, + forall ee': expr, + forall e': expr, + def_sub_expr_subs e ee ee' e' -> + expr_to_kind e = expr_to_kind e'. +Proof. +intros e ee ee' e' H1. +case H1; try (intros; tauto; fail). +Qed. + +Theorem def_sub_expr_subs_assign_sub_lvalue_inversion: + forall t: type, + forall lv: lvalue t, + forall rv: rvalue t, + forall ee' e': expr, + forall ee_sub: executable_sub_expr (lvalue_to_expr t lv), + def_sub_expr_subs (statement_to_expr (assign t lv rv)) + (assign_sub_lvalue t lv rv ee_sub) ee' e' -> + { lv': lvalue t + | def_sub_expr_subs (lvalue_to_expr t lv) ee_sub ee' + (lvalue_to_expr t lv') + & e' = statement_to_expr (assign t lv' rv) }. +Proof. +intros t lv rv ee' [s'|t' lv''|t' rv''] ee_sub H1; + try discriminate (sub_expr_subs_same_kind _ _ _ _ H1). +destruct s' as [| | | |t' lv'' rv''| | | |]; + try(assert (H2: False); [inversion H1|elim H2]; fail). +destruct (type_dec t t') as [H2|H2]; + [|assert (H3: False); + [|elim H3; fail]]. +2: inversion H1 as [];tauto. +subst t'. +exists lv''. + inversion H1 as + [| |t' lv''' lv'''' rv''' ee'' ee_sub' H2 (H3_1,H3_2,H3_3) (H4_1,H4_2,H4_3,H4_4,H4_5) H5 (H6_1,H6_2)| | | |]. +(* Check that all names are the given ones: *) +clear t' lv''' lv'''' rv''' ee'' ee_sub' H2 H3_1 H3_2 H3_3 H4_1 H4_2 H4_3 H4_4 H4_5 H5 H6_1 H6_2. diff --git a/test-suite/bugs/closed/bug_2181.v b/test-suite/bugs/closed/bug_2181.v new file mode 100644 index 0000000000..62820d8699 --- /dev/null +++ b/test-suite/bugs/closed/bug_2181.v @@ -0,0 +1,3 @@ +Class C. +Parameter P: C -> Prop. +Fail Record R: Type := { _: C; u: P _ }. diff --git a/test-suite/bugs/closed/bug_2193.v b/test-suite/bugs/closed/bug_2193.v new file mode 100644 index 0000000000..780636718e --- /dev/null +++ b/test-suite/bugs/closed/bug_2193.v @@ -0,0 +1,31 @@ +(* Computation of dependencies in the "match" return predicate was incomplete *) +(* Submitted by R. O'Connor, Nov 2009 *) + +Inductive Symbol : Set := + | VAR : Symbol. + +Inductive SExpression := + | atomic : Symbol -> SExpression. + +Inductive ProperExpr : SExpression -> SExpression -> Type := + | pe_3 : forall (x : Symbol) (alpha : SExpression), + ProperExpr alpha (atomic VAR) -> + ProperExpr (atomic x) alpha. + +Definition A (P : forall s : SExpression, Type) + (x alpha alpha1 : SExpression) + (t : ProperExpr (x) alpha1) : option (x = atomic VAR) := + match t as pe in ProperExpr a b return option (a = atomic VAR) with + | pe_3 x0 alpha3 tye' => + (fun (x:Symbol) (alpha : SExpression) => @None (atomic x = atomic VAR)) + x0 alpha3 + end. + +Definition B (P : forall s : SExpression, Type) + (x alpha alpha1 : SExpression) + (t : ProperExpr (x) alpha1) : option (x = atomic VAR) := + match t as pe in ProperExpr a b return option (a = atomic VAR) with + | pe_3 x0 alpha3 tye' => + (fun (x:Symbol) (alpha : SExpression) (t:ProperExpr alpha (atomic VAR)) => @None (atomic x = atomic VAR)) + x0 alpha3 tye' + end. diff --git a/test-suite/bugs/closed/bug_2230.v b/test-suite/bugs/closed/bug_2230.v new file mode 100644 index 0000000000..5076fb2bb7 --- /dev/null +++ b/test-suite/bugs/closed/bug_2230.v @@ -0,0 +1,6 @@ +Goal forall f, f 1 1 -> True. +intros. +match goal with + | [ H : _ ?a |- _ ] => idtac +end. +Abort. diff --git a/test-suite/bugs/closed/bug_2231.v b/test-suite/bugs/closed/bug_2231.v new file mode 100644 index 0000000000..03e2c9bbf4 --- /dev/null +++ b/test-suite/bugs/closed/bug_2231.v @@ -0,0 +1,3 @@ +Inductive unit2 : Type := U : unit -> unit2. +Inductive dummy (u: unit2) : unit -> Type := + V: dummy u (let (tt) := u in tt). diff --git a/test-suite/bugs/closed/bug_2243.v b/test-suite/bugs/closed/bug_2243.v new file mode 100644 index 0000000000..6d45c9a09e --- /dev/null +++ b/test-suite/bugs/closed/bug_2243.v @@ -0,0 +1,9 @@ +Inductive is_nul: nat -> Prop := X: is_nul 0. +Section O. +Variable u: nat. +Variable H: is_nul u. +Goal True. +Proof. +destruct H. +Undo. +revert H; intro H; destruct H. diff --git a/test-suite/bugs/closed/bug_2244.v b/test-suite/bugs/closed/bug_2244.v new file mode 100644 index 0000000000..d72c51f216 --- /dev/null +++ b/test-suite/bugs/closed/bug_2244.v @@ -0,0 +1,19 @@ +(* 1st-order unification did not work when in competition with pattern unif. *) + +Set Implicit Arguments. +Lemma test : forall + (A : Type) + (B : Type) + (f : A -> B) + (S : B -> Prop) + (EV : forall y (f':A->B), (forall x', S (f' x')) -> S (f y)) + (HS : forall x', S (f x')) + (x : A), + S (f x). +Proof. + intros. eapply EV. intros. + (* worked in v8.2 but not in v8.3beta, fixed in r12898 *) + apply HS. + + (* still not compatible with 8.2 because an evar can be solved in + two different ways and is left open *) diff --git a/test-suite/bugs/closed/bug_2245.v b/test-suite/bugs/closed/bug_2245.v new file mode 100644 index 0000000000..f0162f3b27 --- /dev/null +++ b/test-suite/bugs/closed/bug_2245.v @@ -0,0 +1,11 @@ +Module Type Test. + +Section Sec. +Variables (A:Type). +Context (B:Type). +End Sec. + +Fail Check B. (* used to be found !!! *) +Fail Check A. + +End Test. diff --git a/test-suite/bugs/closed/bug_2250.v b/test-suite/bugs/closed/bug_2250.v new file mode 100644 index 0000000000..565d7b68fd --- /dev/null +++ b/test-suite/bugs/closed/bug_2250.v @@ -0,0 +1,3 @@ +Check prod: Prop -> Prop -> Prop. +(* (fun A B : Prop => (A * B)%type):Prop -> Prop -> Prop + : Prop -> Prop -> Prop *) diff --git a/test-suite/bugs/closed/bug_2251.v b/test-suite/bugs/closed/bug_2251.v new file mode 100644 index 0000000000..d0fa3f2b33 --- /dev/null +++ b/test-suite/bugs/closed/bug_2251.v @@ -0,0 +1,6 @@ +(* Check that rewrite does not apply to single evars *) + +Lemma evar_rewrite : (forall a : nat, a = 0 -> True) -> True. +intros; eapply H. (* goal is ?30 = nil *) +Fail rewrite plus_n_Sm. +Abort. diff --git a/test-suite/bugs/closed/bug_2255.v b/test-suite/bugs/closed/bug_2255.v new file mode 100644 index 0000000000..ae5024fddd --- /dev/null +++ b/test-suite/bugs/closed/bug_2255.v @@ -0,0 +1,21 @@ +(* Check injection in presence of dependencies hidden in applicative terms *) + +Inductive TupleT : nat -> Type := + nilT : TupleT 0 +| consT {n} A : (A -> TupleT n) -> TupleT (S n). + +Inductive Tuple : forall n, TupleT n -> Type := + nil : Tuple _ nilT +| cons {n} A (x : A) (F : A -> TupleT n) : Tuple _ (F x) -> Tuple _ (consT A F). + +Goal forall n A F x X n0 A0 x0 F0 H0 (H : existT (fun n0 : nat => {H0 : TupleT +n0 & Tuple n0 H0}) + (S n0) + (existT (fun H0 : TupleT (S n0) => Tuple (S n0) H0) + (consT A0 F0) (cons A0 x0 F0 H0)) = + existT (fun n0 : nat => {H0 : TupleT n0 & Tuple n0 H0}) + (S n) + (existT (fun H0 : TupleT (S n) => Tuple (S n) H0) + (consT A F) (cons A x F X))), False. +intros. +injection H. diff --git a/test-suite/bugs/closed/bug_2262.v b/test-suite/bugs/closed/bug_2262.v new file mode 100644 index 0000000000..1533960150 --- /dev/null +++ b/test-suite/bugs/closed/bug_2262.v @@ -0,0 +1,10 @@ + + +Generalizable Variables A. +Class Test A := { test : A }. + +Lemma mylemma : forall `{Test A}, test = test. +Admitted. (* works fine *) + +Definition mylemma' := forall `{Test A}, test = test. +About mylemma'. diff --git a/test-suite/bugs/closed/bug_2281.v b/test-suite/bugs/closed/bug_2281.v new file mode 100644 index 0000000000..8f549b9201 --- /dev/null +++ b/test-suite/bugs/closed/bug_2281.v @@ -0,0 +1,50 @@ +(** Bug #2281 + +In the code below, coq is confused by an equality unless it is first 'subst'ed +away, yet http://coq.inria.fr/stdlib/Coq.FSets.FSetDecide.html says + + fsetdec will first perform any necessary zeta and beta reductions and will +invoke subst to eliminate any Coq equalities between finite sets or their +elements. + +I have coq r12851. + +*) + +Require Import Arith. +Require Import FSets. +Require Import FSetWeakList. + +Module DecidableNat. +Definition t := nat. +Definition eq := @eq nat. +Definition eq_refl := @refl_equal nat. +Definition eq_sym := @sym_eq nat. +Definition eq_trans := @trans_eq nat. +Definition eq_dec := eq_nat_dec. +End DecidableNat. + +Module NatSet := Make(DecidableNat). + +Module Export NameSetDec := WDecide (NatSet). + +Lemma ThisLemmaWorks : forall ( s1 s2 : NatSet.t ) + ( H : s1 = s2 ), + NatSet.Equal s1 s2. +Proof. +intros. +subst. +fsetdec. +Qed. + +Import FSetDecideAuxiliary. + +Lemma ThisLemmaWasFailing : forall ( s1 s2 : NatSet.t ) + ( H : s1 = s2 ), + NatSet.Equal s1 s2. +Proof. +intros. +fsetdec. +(* Error: Tactic failure: because the goal is beyond the scope of this tactic. +*) +Qed. diff --git a/test-suite/bugs/closed/bug_2295.v b/test-suite/bugs/closed/bug_2295.v new file mode 100644 index 0000000000..f5ca28dcaa --- /dev/null +++ b/test-suite/bugs/closed/bug_2295.v @@ -0,0 +1,11 @@ +(* Check if omission of "as" in return clause works w/ section variables too *) + +Section sec. + +Variable b: bool. + +Definition d' := + (match b return b = true \/ b = false with + | true => or_introl _ (refl_equal true) + | false => or_intror _ (refl_equal false) + end). diff --git a/test-suite/bugs/closed/bug_2299.v b/test-suite/bugs/closed/bug_2299.v new file mode 100644 index 0000000000..c0552ca7b3 --- /dev/null +++ b/test-suite/bugs/closed/bug_2299.v @@ -0,0 +1,13 @@ +(* Check that destruct refreshes universes in what it generalizes *) + +Section test. + +Variable A: Type. + +Inductive T: unit -> Type := C: A -> unit -> T tt. + +Let unused := T tt. + +Goal T tt -> False. + intro X. + destruct X. diff --git a/test-suite/bugs/closed/bug_2300.v b/test-suite/bugs/closed/bug_2300.v new file mode 100644 index 0000000000..4e587cbb25 --- /dev/null +++ b/test-suite/bugs/closed/bug_2300.v @@ -0,0 +1,15 @@ +(* Check some behavior of Ltac pattern-matching wrt universe levels *) + +Section contents. + +Variables (A: Type) (B: (unit -> Type) -> Type). + +Inductive C := c: A -> unit -> C. + +Let unused2 (x: unit) := C. + +Goal True. +intuition. +Qed. + +End contents. diff --git a/test-suite/bugs/closed/bug_2303.v b/test-suite/bugs/closed/bug_2303.v new file mode 100644 index 0000000000..e614b9b552 --- /dev/null +++ b/test-suite/bugs/closed/bug_2303.v @@ -0,0 +1,4 @@ +Class A := a: unit. +Class B (x: unit). +Axiom H: forall x: A, @B x -> x = x -> unit. +Definition Field (z: A) (m: @B z) x := (@H _ _ x) = z. diff --git a/test-suite/bugs/closed/bug_2304.v b/test-suite/bugs/closed/bug_2304.v new file mode 100644 index 0000000000..663c42e480 --- /dev/null +++ b/test-suite/bugs/closed/bug_2304.v @@ -0,0 +1,3 @@ +(* This used to fail with an anomaly NotASort at some time *) +Class A (O: Type): Type := a: O -> Type. +Fail Goal forall (x: a tt), @a x = @a x. diff --git a/test-suite/bugs/closed/bug_2307.v b/test-suite/bugs/closed/bug_2307.v new file mode 100644 index 0000000000..2c82a61a68 --- /dev/null +++ b/test-suite/bugs/closed/bug_2307.v @@ -0,0 +1,2 @@ +Inductive V: nat -> Type := VS n: V (S n). +Definition f (e: V 1): nat := match e with VS 0 => 3 end. diff --git a/test-suite/bugs/closed/bug_2310.v b/test-suite/bugs/closed/bug_2310.v new file mode 100644 index 0000000000..14a3e5a7b0 --- /dev/null +++ b/test-suite/bugs/closed/bug_2310.v @@ -0,0 +1,21 @@ +(* Dependent higher-order hole in "refine" (simplified version) *) + +Set Implicit Arguments. + +Inductive Nest t := Cons : Nest (prod t t) -> Nest t. + +Definition cast A x y Heq P H := @eq_rect A x P H y Heq. + +Definition replace a (y:Nest (prod a a)) : a = a -> Nest a. + +(* This used to raise an anomaly Unknown Meta in 8.2 and 8.3beta. + It raises a regular error in 8.3 and almost succeeds with the new + proof engine: there are two solutions to a unification problem + (P:=\a.Nest (prod a a) and P:=\_.Nest (prod a a)) and refine should either + leave P as subgoal or choose itself one solution *) + + intros. Fail refine (Cons (cast H _ y)). + Unset Solve Unification Constraints. (* Keep the unification constraint around *) + refine (Cons (cast H _ y)). + intros. + refine (Nest (prod X X)). Qed. diff --git a/test-suite/bugs/closed/bug_2319.v b/test-suite/bugs/closed/bug_2319.v new file mode 100644 index 0000000000..73d95e91a1 --- /dev/null +++ b/test-suite/bugs/closed/bug_2319.v @@ -0,0 +1,13 @@ +Section S. + + CoInductive A (X: Type) := mkA: A X -> A X. + Variable T : Type. + + (* This used to loop (bug #2319) *) + Timeout 5 Eval vm_compute in cofix s : A T := mkA T s. + + CoFixpoint s : A T := mkA T s + with t : A unit := mkA unit (mkA unit t). + Timeout 5 Eval vm_compute in s. + +End S. diff --git a/test-suite/bugs/closed/bug_2320.v b/test-suite/bugs/closed/bug_2320.v new file mode 100644 index 0000000000..1616a29de6 --- /dev/null +++ b/test-suite/bugs/closed/bug_2320.v @@ -0,0 +1,14 @@ +(* Managing metavariables in the return clause of a match *) + +(* This was working in 8.1 but is failing in 8.2 and 8.3. It works in + trunk thanks to the new proof engine. It could probably made to work in + 8.2 and 8.3 if a return predicate of the form "dummy 0" instead of + (or in addition to) a sophisticated predicate of the form + "as x in dummy y return match y with 0 => ?P | _ => ID end" *) + +Inductive dummy : nat -> Prop := constr : dummy 0. + +Lemma failure : forall (x : dummy 0), x = constr. +Proof. +intros x. +refine (match x with constr => _ end). diff --git a/test-suite/bugs/closed/bug_2342.v b/test-suite/bugs/closed/bug_2342.v new file mode 100644 index 0000000000..e55bda05a6 --- /dev/null +++ b/test-suite/bugs/closed/bug_2342.v @@ -0,0 +1,7 @@ +(* Checking that the type inference algoithme does not commit to an + equality over sorts when only a subtyping constraint is around *) + +Parameter A : Set. +Parameter B : A -> Set. +Parameter F : Set -> Prop. +Check (F (forall x, B x)). diff --git a/test-suite/bugs/closed/bug_2347.v b/test-suite/bugs/closed/bug_2347.v new file mode 100644 index 0000000000..11456c7e35 --- /dev/null +++ b/test-suite/bugs/closed/bug_2347.v @@ -0,0 +1,10 @@ +Require Import EquivDec List. +Generalizable All Variables. + +Program Definition list_eqdec `(eqa : EqDec A eq) : EqDec (list A) eq := + (fun (x y : list A) => _). +Admit Obligations of list_eqdec. + +Program Definition list_eqdec' `(eqa : EqDec A eq) : EqDec (list A) eq := + (fun _ : nat => (fun (x y : list A) => _)) 0. +Admit Obligations of list_eqdec'. diff --git a/test-suite/bugs/closed/bug_2350.v b/test-suite/bugs/closed/bug_2350.v new file mode 100644 index 0000000000..e91f22e267 --- /dev/null +++ b/test-suite/bugs/closed/bug_2350.v @@ -0,0 +1,6 @@ +(* Check that the fix tactic, when called from refine, reduces enough + to see the products *) + +Definition foo := forall n:nat, n=n. +Definition bar : foo. +refine (fix aux (n:nat) := _). diff --git a/test-suite/bugs/closed/bug_2353.v b/test-suite/bugs/closed/bug_2353.v new file mode 100644 index 0000000000..baae9a6ece --- /dev/null +++ b/test-suite/bugs/closed/bug_2353.v @@ -0,0 +1,12 @@ +(* Are recursively non-uniform params correctly treated? *) +Inductive list (A:nat -> Type) n := cons : A n -> list A (S n) -> list A n. +Inductive term n := app (l : list term n). +Definition term_list := + fix term_size n (t : term n) (acc : nat) {struct t} : nat := + match t with + | app _ l => + (fix term_list_size n (l : list term n) (acc : nat) {struct l} : nat := + match l with + | cons _ _ t q => term_list_size (S n) q (term_size n t acc) + end) n l (S acc) + end. diff --git a/test-suite/bugs/closed/bug_2360.v b/test-suite/bugs/closed/bug_2360.v new file mode 100644 index 0000000000..9aea5f3615 --- /dev/null +++ b/test-suite/bugs/closed/bug_2360.v @@ -0,0 +1,12 @@ +(* This failed in V8.3 because descend_in_conjunctions built ill-typed terms *) +Definition interp (etyp : nat -> Type) (p: nat) := etyp p. + +Record Value (etyp : nat -> Type) := Mk { + typ : nat; + value : interp etyp typ +}. + +Definition some_value (etyp : nat -> Type) : (Value etyp). +Proof. + intros. + Fail apply Mk. (* Check that it does not raise an anomaly *) diff --git a/test-suite/bugs/closed/bug_2362.v b/test-suite/bugs/closed/bug_2362.v new file mode 100644 index 0000000000..ffd51a5dba --- /dev/null +++ b/test-suite/bugs/closed/bug_2362.v @@ -0,0 +1,36 @@ +Set Implicit Arguments. + +Class Pointed (M:Type -> Type) := +{ + creturn: forall {A: Type}, A -> M A +}. + +Unset Implicit Arguments. +Inductive FPair (A B:Type) (neutral: B) : Type:= + fpair : forall (a:A) (b:B), FPair A B neutral. +Arguments fpair {A B neutral}. + +Set Implicit Arguments. + +Notation "( x ,> y )" := (fpair x y) (at level 0). + +Instance Pointed_FPair B neutral: + Pointed (fun A => FPair A B neutral) := + { creturn := fun A (a:A) => (a,> neutral) }. +Definition blah_fail (x:bool) : FPair bool nat O := + creturn x. +Set Printing All. Print blah_fail. + +Definition blah_explicit (x:bool) : FPair bool nat O := + @creturn _ (Pointed_FPair _ ) _ x. + +Print blah_explicit. + + +Instance Pointed_FPair_mono: + Pointed (fun A => FPair A nat 0) := + { creturn := fun A (a:A) => (a,> 0) }. + + +Definition blah (x:bool) : FPair bool nat O := + creturn x. diff --git a/test-suite/bugs/closed/bug_2375.v b/test-suite/bugs/closed/bug_2375.v new file mode 100644 index 0000000000..f1ca269646 --- /dev/null +++ b/test-suite/bugs/closed/bug_2375.v @@ -0,0 +1,17 @@ +(* In the following code, the (superfluous) lemma [lem] is responsible +for the failure of congruence. *) + +Definition f : nat -> Prop := fun x => True. + +Lemma lem : forall x, (True -> True) = ( True -> f x). +Proof. + intros. reflexivity. +Qed. + +Goal forall (x:nat), x = x. +Proof. + intros. + assert (lem := lem). + (*clear ax.*) + congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_2378.v b/test-suite/bugs/closed/bug_2378.v new file mode 100644 index 0000000000..b9dd654057 --- /dev/null +++ b/test-suite/bugs/closed/bug_2378.v @@ -0,0 +1,610 @@ +Require Import TestSuite.admit. +(* test with Coq 8.3rc1 *) + +Require Import Program. + +Inductive Unit: Set := unit: Unit. + +Definition eq_dec T := forall x y:T, {x=y}+{x<>y}. + +Section TTS_TASM. + +Variable Time: Set. +Variable Zero: Time. +Variable tle: Time -> Time -> Prop. +Variable tlt: Time -> Time -> Prop. +Variable tadd: Time -> Time -> Time. +Variable tsub: Time -> Time -> Time. +Variable tmin: Time -> Time -> Time. +Notation "t1 @<= t2" := (tle t1 t2) (at level 70, no associativity). +Notation "t1 @< t2" := (tlt t1 t2) (at level 70, no associativity). +Notation "t1 @+ t2" := (tadd t1 t2) (at level 50, left associativity). +Notation "t1 @- t2" := (tsub t1 t2) (at level 50, left associativity). +Notation "t1 @<= t2 @<= t3" := ((tle t1 t2) /\ (tle t2 t3)) (at level 70, t2 at next level). +Notation "t1 @<= t2 @< t3" := ((tle t1 t2) /\ (tlt t2 t3)) (at level 70, t2 at next level). + +Variable tzerop: forall n, (n = Zero) + {Zero @< n}. +Variable tlt_eq_gt_dec: forall x y, {x @< y} + {x=y} + {y @< x}. +Variable tle_plus_l: forall n m, n @<= n @+ m. +Variable tle_lt_eq_dec: forall n m, n @<= m -> {n @< m} + {n = m}. + +Variable tzerop_zero: tzerop Zero = inleft (Zero @< Zero) (@eq_refl _ Zero). +Variable tplus_n_O: forall n, n @+ Zero = n. +Variable tlt_le_weak: forall n m, n @< m -> n @<= m. +Variable tlt_irrefl: forall n, ~ n @< n. +Variable tplus_nlt: forall n m, ~n @+ m @< n. +Variable tle_n: forall n, n @<= n. +Variable tplus_lt_compat_l: forall n m p, n @< m -> p @+ n @< p @+ m. +Variable tlt_trans: forall n m p, n @< m -> m @< p -> n @< p. +Variable tle_lt_trans: forall n m p, n @<= m -> m @< p -> n @< p. +Variable tlt_le_trans: forall n m p, n @< m -> m @<= p -> n @< p. +Variable tle_refl: forall n, n @<= n. +Variable tplus_le_0: forall n m, n @+ m @<= n -> m = Zero. +Variable Time_eq_dec: eq_dec Time. + +(*************************************************************) + +Section PropLogic. +Variable Predicate: Type. + +Inductive LP: Type := + LPPred: Predicate -> LP +| LPAnd: LP -> LP -> LP +| LPNot: LP -> LP. + +Variable State: Type. +Variable Sat: State -> Predicate -> Prop. + +Fixpoint lpSat st f: Prop := + match f with + LPPred p => Sat st p + | LPAnd f1 f2 => lpSat st f1 /\ lpSat st f2 + | LPNot f1 => ~lpSat st f1 + end. +End PropLogic. + +Arguments lpSat : default implicits. + +Fixpoint LPTransfo Pred1 Pred2 p2lp (f: LP Pred1): LP Pred2 := + match f with + LPPred _ p => p2lp p + | LPAnd _ f1 f2 => LPAnd _ (LPTransfo Pred1 Pred2 p2lp f1) (LPTransfo Pred1 Pred2 p2lp f2) + | LPNot _ f1 => LPNot _ (LPTransfo Pred1 Pred2 p2lp f1) + end. +Arguments LPTransfo : default implicits. + +Definition addIndex (Ind:Type) (Pred: Ind -> Type) (i: Ind) f := + LPTransfo (fun p => LPPred _ (existT (fun i => Pred i) i p)) f. + +Section TTS. + +Variable State: Type. + +Record TTS: Type := mkTTS { + Init: State -> Prop; + Delay: State -> Time -> State -> Prop; + Next: State -> State -> Prop; + Predicate: Type; + Satisfy: State -> Predicate -> Prop +}. + +Definition TTSIndexedProduct Ind (tts: Ind -> TTS): TTS := mkTTS + (fun st => forall i, Init (tts i) st) + (fun st d st' => forall i, Delay (tts i) st d st') + (fun st st' => forall i, Next (tts i) st st') + { i: Ind & Predicate (tts i) } + (fun st p => Satisfy (tts (projT1 p)) st (projT2 p)). + +End TTS. + +Section SIMU_F. + +Variables StateA StateC: Type. + +Record mapping: Type := mkMapping { + mState: Type; + mInit: StateC -> mState; + mNext: mState -> StateC -> mState; + mDelay: mState -> StateC -> Time -> mState; + mabs: mState -> StateC -> StateA +}. + +Variable m: mapping. + +Record simu (Pred: Type) (a: TTS StateA) (c: TTS StateC) (tra: Pred -> LP (Predicate _ a)) (trc: Pred -> LP (Predicate _ c)): Type := simuPrf { + inv: (mState m) -> StateC -> Prop; + invInit: forall st, Init _ c st -> inv (mInit m st) st; + invDelay: forall ex1 st1 st2 d, Delay _ c st1 d st2 -> inv ex1 st1 -> inv (mDelay m ex1 st1 d) st2; + invNext: forall ex1 st1 st2, Next _ c st1 st2 -> inv ex1 st1 -> inv (mNext m ex1 st1) st2; + simuInit: forall st, Init _ c st -> Init _ a (mabs m (mInit m st) st); + simuDelay: forall ex1 st1 st2 d, Delay _ c st1 d st2 -> inv ex1 st1 -> + Delay _ a (mabs m ex1 st1) d (mabs m (mDelay m ex1 st1 d) st2); + simuNext: forall ex1 st1 st2, Next _ c st1 st2 -> inv ex1 st1 -> + Next _ a (mabs m ex1 st1) (mabs m (mNext m ex1 st1) st2); + simuPred: forall ext st, inv ext st -> + (forall p, lpSat (Satisfy _ c) st (trc p) <-> lpSat (Satisfy _ a) (mabs m ext st) (tra p)) +}. + +Theorem satProd: forall State Ind Pred (Sat: forall i, State -> Pred i -> Prop) (st:State) i (f: LP (Pred i)), + lpSat (Sat i) st f + <-> + lpSat + (fun (st : State) (p : {i : Ind & Pred i}) => Sat (projT1 p) st (projT2 p)) st + (addIndex Ind _ i f). +Proof. + induction f; simpl; intros; split; intros; intuition. +Qed. + +Definition trProd (State: Type) Ind (Pred: Ind -> Type) (tts: Ind -> TTS State) (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))): + {i:Ind & Pred i} -> LP (Predicate _ (TTSIndexedProduct _ Ind tts)) := + fun p => addIndex Ind _ (projT1 p) (tr (projT1 p) (projT2 p)). + +Arguments trProd : default implicits. +Require Import Setoid. + +Theorem satTrProd: + forall State Ind Pred (tts: Ind -> TTS State) + (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))) (st:State) (p: {i:Ind & (Pred i)}), + lpSat (Satisfy _ (tts (projT1 p))) st (tr (projT1 p) (projT2 p)) + <-> + lpSat (Satisfy _ (TTSIndexedProduct _ _ tts)) st (trProd _ tts tr p). +Proof. + unfold trProd, TTSIndexedProduct; simpl; intros. + rewrite (satProd State Ind (fun i => Predicate State (tts i)) + (fun i => Satisfy _ (tts i))); tauto. +Qed. + +Theorem simuProd: + forall Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) + (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) + (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), + (forall i, simu _ (tta i) (ttc i) (tra i) (trc i)) -> + simu _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) + (trProd Pred tta tra) (trProd Pred ttc trc). +Proof. + intros. + apply simuPrf with (fun ex st => forall i, inv _ _ (ttc i) (tra i) (trc i) (X i) ex st); simpl; intros; auto. + eapply invInit; eauto. + eapply invDelay; eauto. + eapply invNext; eauto. + eapply simuInit; eauto. + eapply simuDelay; eauto. + eapply simuNext; eauto. + split; simpl; intros. + generalize (proj1 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. + rewrite <- (satTrProd StateA Ind Pred tta tra); apply H1. + rewrite (satTrProd StateC Ind Pred ttc trc); apply H0. + + generalize (proj2 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. + rewrite <- (satTrProd StateC Ind Pred ttc trc); apply H1. + rewrite (satTrProd StateA Ind Pred tta tra); apply H0. +Qed. + +End SIMU_F. + +Section TRANSFO. + +Record simu_equiv StateA StateC m1 m2 Pred (a: TTS StateA) (c: TTS StateC) (tra: Pred -> LP (Predicate _ a)) (trc: Pred -> LP (Predicate _ c)): Type := simuEquivPrf { + simuLR: simu StateA StateC m1 Pred a c tra trc; + simuRL: simu StateC StateA m2 Pred c a trc tra +}. + +Theorem simu_equivProd: + forall StateA StateC m1 m2 Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) + (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) + (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), + (forall i, simu_equiv StateA StateC m1 m2 _ (tta i) (ttc i) (tra i) (trc i)) -> + simu_equiv StateA StateC m1 m2 _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) + (trProd _ _ Pred tta tra) (trProd _ _ Pred ttc trc). +Proof. + intros; split; intros. + apply simuProd; intro. + elim (X i); auto. + apply simuProd; intro. + elim (X i); auto. +Qed. + +Record RTLanguage: Type := mkRTLanguage { + Syntax: Type; + DynamicState: Syntax -> Type; + Semantic: forall (mdl:Syntax), TTS (DynamicState mdl); + MdlPredicate: Syntax -> Type; + MdlPredicateDefinition: forall mdl, MdlPredicate mdl -> LP (Predicate _ (Semantic mdl)) +}. + +Record Transformation (l1 l2: RTLanguage): Type := mkTransformation { + Tmodel: Syntax l1 -> Syntax l2; + Tl1l2: forall mdl, mapping (DynamicState l1 mdl) (DynamicState l2 (Tmodel mdl)); + Tl2l1: forall mdl, mapping (DynamicState l2 (Tmodel mdl)) (DynamicState l1 mdl); + Tpred: forall mdl, MdlPredicate l1 mdl -> LP (MdlPredicate l2 (Tmodel mdl)); + Tsim: forall mdl, simu_equiv (DynamicState l1 mdl) (DynamicState l2 (Tmodel mdl)) (Tl1l2 mdl) (Tl2l1 mdl) + (MdlPredicate l1 mdl) (Semantic l1 mdl) (Semantic l2 (Tmodel mdl)) + (MdlPredicateDefinition l1 mdl) + (fun p => LPTransfo (MdlPredicateDefinition l2 (Tmodel mdl)) (Tpred mdl p)) +}. + +Section Product. + +Record PSyntax (L: RTLanguage): Type := mkPSyntax { + pIndex: Type; + pIsEmpty: pIndex + {pIndex -> False}; + pState: Type; + pComponents: pIndex -> Syntax L; + pIsShared: forall i, DynamicState L (pComponents i) = pState +}. + +Definition pPredicate (L: RTLanguage) (sys: PSyntax L) := { i : pIndex L sys & MdlPredicate L (pComponents L sys i)}. + +(* product with shared state *) + +Definition PLanguage (L: RTLanguage): RTLanguage := + mkRTLanguage + (PSyntax L) + (pState L) + (fun mdl => TTSIndexedProduct (pState L mdl) (pIndex L mdl) + (fun i => match pIsShared L mdl i in (_ = y) return TTS y with + eq_refl => Semantic L (pComponents L mdl i) + end)) + (pPredicate L) + (fun mdl => trProd _ _ _ _ + (fun i pi => match pIsShared L mdl i as e in (_ = y) return + (LP (Predicate y + match e in (_ = y0) return (TTS y0) with + | eq_refl => Semantic L (pComponents L mdl i) + end)) + with + | eq_refl => MdlPredicateDefinition L (pComponents L mdl i) pi + end)). + +Inductive Empty: Type :=. + +Record isSharedTransfo l1 l2 tr: Prop := isSharedTransfoPrf { +sameState: forall mdl i j, + DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) = + DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j)); +sameMState: forall mdl i j, + mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl i)) = + mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl j)); +sameM12: forall mdl i j, + Tl1l2 _ _ tr (pComponents l1 mdl i) = + match sym_eq (sameState mdl i j) in _=y return mapping _ y with + eq_refl => match sym_eq (pIsShared l1 mdl i) in _=x return mapping x _ with + eq_refl => match pIsShared l1 mdl j in _=x return mapping x _ with + eq_refl => Tl1l2 _ _ tr (pComponents l1 mdl j) + end + end + end; +sameM21: forall mdl i j, + Tl2l1 l1 l2 tr (pComponents l1 mdl i) = + match + sym_eq (sameState mdl i j) in (_ = y) + return (mapping y (DynamicState l1 (pComponents l1 mdl i))) + with eq_refl => + match + sym_eq (pIsShared l1 mdl i) in (_ = y) + return + (mapping (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j))) y) + with + | eq_refl => + match + pIsShared l1 mdl j in (_ = y) + return + (mapping + (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j))) y) + with + | eq_refl => Tl2l1 l1 l2 tr (pComponents l1 mdl j) + end + end +end +}. + +Definition PTransfoSyntax l1 l2 tr (h: isSharedTransfo l1 l2 tr) mdl := + mkPSyntax l2 (pIndex l1 mdl) + (pIsEmpty l1 mdl) + (match pIsEmpty l1 mdl return Type with + inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) + |inright h => pState l1 mdl + end) + (fun i => Tmodel l1 l2 tr (pComponents l1 mdl i)) + (fun i => match pIsEmpty l1 mdl as y return + (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) = + match y with + | inleft i0 => + DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i0)) + | inright _ => pState l1 mdl + end) + with + inleft j => sameState l1 l2 tr h mdl i j + | inright h => match h i with end + end). + +Definition compSemantic l mdl i := + match pIsShared l mdl i in (_=y) return TTS y with + eq_refl => Semantic l (pComponents l mdl i) + end. + +Definition compSemanticEq l mdl i s (e: DynamicState l (pComponents l mdl i) = s) := + match e in (_=y) return TTS y with + eq_refl => Semantic l (pComponents l mdl i) + end. + +Definition Pmap12 l1 l2 tr (h: isSharedTransfo l1 l2 tr) (mdl : PSyntax l1) := +match + pIsEmpty l1 mdl as s + return + (mapping (pState l1 mdl) + match s with + | inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) + | inright _ => pState l1 mdl + end) +with +| inleft p => + match + pIsShared l1 mdl p in (_ = y) + return + (mapping y (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p)))) + with + | eq_refl => Tl1l2 l1 l2 tr (pComponents l1 mdl p) + end +| inright _ => + mkMapping (pState l1 mdl) (pState l1 mdl) Unit + (fun _ : pState l1 mdl => unit) + (fun (_ : Unit) (_ : pState l1 mdl) => unit) + (fun (_ : Unit) (_ : pState l1 mdl) (_ : Time) => unit) + (fun (_ : Unit) (X : pState l1 mdl) => X) +end. + +Definition Pmap21 l1 l2 tr (h : isSharedTransfo l1 l2 tr) mdl := +match + pIsEmpty l1 mdl as s + return + (mapping + match s with + | inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) + | inright _ => pState l1 mdl + end (pState l1 mdl)) +with +| inleft p => + match + pIsShared l1 mdl p in (_ = y) + return + (mapping (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p))) y) + with + | eq_refl => Tl2l1 l1 l2 tr (pComponents l1 mdl p) + end +| inright _ => + mkMapping (pState l1 mdl) (pState l1 mdl) Unit + (fun _ : pState l1 mdl => unit) + (fun (_ : Unit) (_ : pState l1 mdl) => unit) + (fun (_ : Unit) (_ : pState l1 mdl) (_ : Time) => unit) + (fun (_ : Unit) (X : pState l1 mdl) => X) +end. + +Definition PTpred l1 l2 tr (h : isSharedTransfo l1 l2 tr) mdl (pp : pPredicate l1 mdl): + LP (MdlPredicate (PLanguage l2) (PTransfoSyntax l1 l2 tr h mdl)) := +match pIsEmpty l1 mdl with +| inleft _ => + let (x, p) := pp in + addIndex (pIndex l1 mdl) (fun i => MdlPredicate l2 (Tmodel l1 l2 tr (pComponents l1 mdl i))) x + (LPTransfo (Tpred l1 l2 tr (pComponents l1 mdl x)) + (LPPred (MdlPredicate l1 (pComponents l1 mdl x)) p)) +| inright f => match f (projT1 pp) with end +end. + +Lemma simu_eqA: + forall A1 A2 C m P sa sc tta ttc (h: A2=A1), + simu A1 C (match h in (_=y) return mapping _ C with eq_refl => m end) + P (match h in (_=y) return TTS y with eq_refl => sa end) + sc (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => tta p end) + ttc -> + simu A2 C m P sa sc tta ttc. +admit. +Qed. + +Lemma simu_eqC: + forall A C1 C2 m P sa sc tta ttc (h: C2=C1), + simu A C1 (match h in (_=y) return mapping A _ with eq_refl => m end) + P sa (match h in (_=y) return TTS y with eq_refl => sc end) + tta (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => ttc p end) + -> + simu A C2 m P sa sc tta ttc. +admit. +Qed. + +Lemma simu_eqA1: + forall A1 A2 C m P sa sc tta ttc (h: A1=A2), + simu A1 C m + P + (match (sym_eq h) in (_=y) return TTS y with eq_refl => sa end) sc + (fun p => match (sym_eq h) as e in (_=y) return LP (Predicate y (match e in (_=z) return TTS z with eq_refl => sa end)) with eq_refl => tta p end) ttc + -> + simu A2 C (match h in (_=y) return mapping _ C with eq_refl => m end) P sa sc tta ttc. +admit. +Qed. + +Lemma simu_eqA2: + forall A1 A2 C m P sa sc tta ttc (h: A1=A2), + simu A1 C (match (sym_eq h) in (_=y) return mapping _ C with eq_refl => m end) + P + sa sc tta ttc + -> + simu A2 C m P + (match h in (_=y) return TTS y with eq_refl => sa end) sc + (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sa end) with eq_refl => tta p end) + ttc. +admit. +Qed. + +Lemma simu_eqC2: + forall A C1 C2 m P sa sc tta ttc (h: C1=C2), + simu A C1 (match (sym_eq h) in (_=y) return mapping A _ with eq_refl => m end) + P + sa sc tta ttc + -> + simu A C2 m P + sa (match h in (_=y) return TTS y with eq_refl => sc end) + tta (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sc end) with eq_refl => ttc p end). +admit. +Qed. + +Lemma simu_eqM: + forall A C m1 m2 P sa sc tta ttc (h: m1=m2), + simu A C m1 P sa sc tta ttc + -> + simu A C m2 P sa sc tta ttc. +admit. +Qed. + +Lemma LPTransfo_trans: + forall Pred1 Pred2 Pred3 (tr1: Pred1 -> LP Pred2) (tr2: Pred2 -> LP Pred3) f, + LPTransfo tr2 (LPTransfo tr1 f) = LPTransfo (fun x => LPTransfo tr2 (tr1 x)) f. +Proof. + admit. +Qed. + +Lemma LPTransfo_addIndex: + forall Ind Pred tr1 x (tr2: forall i, Pred i -> LP (tr1 i)) (p: LP (Pred x)), + addIndex Ind tr1 x (LPTransfo (tr2 x) p) = + LPTransfo + (fun p0 : {i : Ind & Pred i} => + addIndex Ind tr1 (projT1 p0) (tr2 (projT1 p0) (projT2 p0))) + (addIndex Ind Pred x p). +Proof. + unfold addIndex; intros. + rewrite LPTransfo_trans. + rewrite LPTransfo_trans. + simpl. + auto. +Qed. + +Record tr_compat I0 I1 tr := compatPrf { + and_compat: forall p1 p2, tr (LPAnd I0 p1 p2) = LPAnd I1 (tr p1) (tr p2); + not_compat: forall p, tr (LPNot I0 p) = LPNot I1 (tr p) +}. + +Lemma LPTransfo_addIndex_tr: + forall Ind Pred tr0 tr1 x (tr2: forall i, Pred i -> LP (tr0 i)) (tr3: forall i, LP (tr0 i) -> LP (tr1 i)) (p: LP (Pred x)), + (forall x, tr_compat (tr0 x) (tr1 x) (tr3 x)) -> + addIndex Ind tr1 x (tr3 x (LPTransfo (tr2 x) p)) = + LPTransfo + (fun p0 : {i : Ind & Pred i} => + addIndex Ind tr1 (projT1 p0) (tr3 (projT1 p0) (tr2 (projT1 p0) (projT2 p0)))) + (addIndex Ind Pred x p). +Proof. + unfold addIndex; simpl; intros. + rewrite LPTransfo_trans; simpl. + rewrite <- LPTransfo_trans. + f_equal. + induction p; simpl; intros; auto. + rewrite (and_compat _ _ _ (H x)). + rewrite <- IHp1, <- IHp2; auto. + rewrite <- IHp. + rewrite (not_compat _ _ _ (H x)); auto. +Qed. + +Require Export Coq.Logic.FunctionalExtensionality. +Print PLanguage. + +Program Definition PTransfo l1 l2 (tr: Transformation l1 l2) (h: isSharedTransfo l1 l2 tr): +Transformation (PLanguage l1) (PLanguage l2) := + mkTransformation (PLanguage l1) (PLanguage l2) + (PTransfoSyntax l1 l2 tr h) + (Pmap12 l1 l2 tr h) + (Pmap21 l1 l2 tr h) + (PTpred l1 l2 tr h) + (fun mdl => simu_equivProd + (pState l1 mdl) + (pState l2 (PTransfoSyntax l1 l2 tr h mdl)) + (Pmap12 l1 l2 tr h mdl) + (Pmap21 l1 l2 tr h mdl) + (pIndex l1 mdl) + (fun i => MdlPredicate l1 (pComponents l1 mdl i)) + (compSemantic l1 mdl) + (compSemantic l2 (PTransfoSyntax l1 l2 tr h mdl)) + _ + _ + _ + ). + +Next Obligation. + unfold compSemantic, PTransfoSyntax; simpl. + case (pIsEmpty l1 mdl); simpl; intros. + unfold pPredicate; simpl. + unfold pPredicate in X; simpl in X. + case (sameState l1 l2 tr h mdl i p). + apply (LPTransfo (MdlPredicateDefinition l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)))). + apply (LPTransfo (Tpred l1 l2 tr (pComponents l1 mdl i))). + apply (LPPred _ X). + + apply False_rect; apply (f i). +Defined. + +Next Obligation. + split; intros. + unfold Pmap12; simpl. + unfold PTransfo_obligation_1; simpl. + unfold compSemantic; simpl. + unfold eq_ind, eq_rect, f_equal; simpl. + case (pIsEmpty l1 mdl); intros. + apply simu_eqA2. + apply simu_eqC2. + apply simu_eqM with (Tl1l2 l1 l2 tr (pComponents l1 mdl i)). + apply sameM12. + apply (simuLR _ _ _ _ _ _ _ _ _ (Tsim l1 l2 tr (pComponents l1 mdl i))); intro. + + apply False_rect; apply (f i). + + unfold Pmap21; simpl. + unfold PTransfo_obligation_1; simpl. + unfold compSemantic; simpl. + unfold eq_ind, eq_rect, f_equal; simpl. + case (pIsEmpty l1 mdl); intros. + apply simu_eqC2. + apply simu_eqA2. + apply simu_eqM with (Tl2l1 l1 l2 tr (pComponents l1 mdl i)). + apply sameM21. + apply (simuRL _ _ _ _ _ _ _ _ _ (Tsim l1 l2 tr (pComponents l1 mdl i))); intro. + + apply False_rect; apply (f i). +Qed. + +Next Obligation. + unfold trProd; simpl. + unfold PTransfo_obligation_1; simpl. + unfold compSemantic; simpl. + unfold eq_ind, eq_rect, f_equal; simpl. + apply functional_extensionality; intro. + case x; clear x; intros. + unfold PTpred; simpl. + case (pIsEmpty l1 mdl); simpl; intros. + set (tr0 i := + Predicate (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i))) + (Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)))). + set (tr1 i := + Predicate (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p))) + match sameState l1 l2 tr h mdl i p in (_ = y) return (TTS y) with + | eq_refl => Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) + end). + set (tr2 x := MdlPredicateDefinition l2 (Tmodel l1 l2 tr (pComponents l1 mdl x))). + set (Pred x := MdlPredicate l2 (Tmodel l1 l2 tr (pComponents l1 mdl x))). + set (tr3 x f := match + sameState l1 l2 tr h mdl x p as e in (_ = y) + return + (LP + (Predicate y + match e in (_ = y0) return (TTS y0) with + | eq_refl => Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl x)) + end)) + with + | eq_refl => f + end). + apply (LPTransfo_addIndex_tr _ Pred tr0 tr1 x tr2 tr3 + (Tpred l1 l2 tr (pComponents l1 mdl x) m)). + unfold tr0, tr1, tr3; intros; split; simpl; intros; auto. + case (sameState l1 l2 tr h mdl x0 p); auto. + case (sameState l1 l2 tr h mdl x0 p); auto. + + apply False_rect; apply (f x). +Qed. + +End Product. diff --git a/test-suite/bugs/closed/bug_2388.v b/test-suite/bugs/closed/bug_2388.v new file mode 100644 index 0000000000..fbe5e20f2f --- /dev/null +++ b/test-suite/bugs/closed/bug_2388.v @@ -0,0 +1,9 @@ +(* Error message was not printed in the correct environment *) + +Fail Parameters (A:Prop) (a:A A). + +(* This is a variant (reported as part of bug #2347) *) + +Require Import EquivDec. +Fail Program Instance bool_eq_eqdec : EqDec bool eq := + {equiv_dec x y := (fix aux (x y : bool) {struct x}:= aux _ y) x y}. diff --git a/test-suite/bugs/closed/bug_2393.v b/test-suite/bugs/closed/bug_2393.v new file mode 100644 index 0000000000..fb4f92619f --- /dev/null +++ b/test-suite/bugs/closed/bug_2393.v @@ -0,0 +1,13 @@ +Require Import Program. + +Inductive T := MkT. + +Definition sizeOf (t : T) : nat + := match t with + | MkT => 1 + end. +Variable vect : nat -> Type. +Program Fixpoint idType (t : T) (n := sizeOf t) (b : vect n) {measure n} : T + := match t with + | MkT => MkT + end. diff --git a/test-suite/bugs/closed/bug_2404.v b/test-suite/bugs/closed/bug_2404.v new file mode 100644 index 0000000000..f6ec676014 --- /dev/null +++ b/test-suite/bugs/closed/bug_2404.v @@ -0,0 +1,46 @@ +(* Check that dependencies in the indices of the type of the terms to + match are taken into account and correctly generalized *) + +Require Import Relations.Relation_Definitions. +Require Import Basics. + +Record Base := mkBase + {(* Primitives *) + World : Set + (* Names are real, links are theoretical *) + ; Name : World -> Set + + ; wweak : World -> World -> Prop + + ; exportw : forall a b : World, (wweak a b) -> (Name b) -> option (Name a) +}. + +Section Derived. + Variable base : Base. + Definition bWorld := World base. + Definition bName := Name base. + Definition bexportw := exportw base. + Definition bwweak := wweak base. + + Arguments bexportw [a b]. + +Inductive RstarSetProof {I : Type} (T : I -> I -> Type) : I -> I -> Type := + starReflS : forall a, RstarSetProof T a a +| starTransS : forall i j k, T i j -> (RstarSetProof T j k) -> RstarSetProof T i k. + +Arguments starTransS [I T i j k]. + +Definition RstarInv {A : Set} (rel : relation A) : A -> A -> Type := (flip (RstarSetProof (flip rel))). + +Definition bwweakFlip (b a : bWorld) : Prop := (bwweak a b). +Definition Rweak : forall a b : bWorld, Type := RstarInv bwweak. + +Fixpoint exportRweak {a b} (aRWb : Rweak a b) (y : bName b) : option (bName a) := + match aRWb,y with + | starReflS _ a, y' => Some y' + | starTransS jWk jRWi, y' => + match (bexportw jWk y) with + | Some x => exportRweak jRWi x + | None => None + end + end. diff --git a/test-suite/bugs/closed/bug_2406.v b/test-suite/bugs/closed/bug_2406.v new file mode 100644 index 0000000000..3766e795a0 --- /dev/null +++ b/test-suite/bugs/closed/bug_2406.v @@ -0,0 +1,6 @@ +(* Check correct handling of unsupported notations *) +Notation "'’'" := (fun x => x) (at level 20). + +(* This fails with a syntax error but it is not caught by Fail +Fail Definition crash_the_rooster f := ’. +*) diff --git a/test-suite/bugs/closed/bug_2417.v b/test-suite/bugs/closed/bug_2417.v new file mode 100644 index 0000000000..b2f00ffc65 --- /dev/null +++ b/test-suite/bugs/closed/bug_2417.v @@ -0,0 +1,15 @@ +Parameter x y : nat. +Axiom H : x = y. +Hint Rewrite H : mybase. + +Ltac bar base := autorewrite with base. + +Tactic Notation "foo" ident(base) := autorewrite with base. + +Goal x = 0. + bar mybase. + now_show (y = 0). + Undo 2. + foo mybase. + now_show (y = 0). +Abort. diff --git a/test-suite/bugs/closed/bug_2428.v b/test-suite/bugs/closed/bug_2428.v new file mode 100644 index 0000000000..b398a76d91 --- /dev/null +++ b/test-suite/bugs/closed/bug_2428.v @@ -0,0 +1,10 @@ +Axiom P : nat -> Prop. + +Definition myFact := forall x, P x. + +Hint Extern 1 (P _) => progress (unfold myFact in *). + +Lemma test : (True -> myFact) -> P 3. +Proof. + intros. debug eauto. +Qed. diff --git a/test-suite/bugs/closed/bug_2447.v b/test-suite/bugs/closed/bug_2447.v new file mode 100644 index 0000000000..fdeb69fcc7 --- /dev/null +++ b/test-suite/bugs/closed/bug_2447.v @@ -0,0 +1,7 @@ +Record t := {x : bool; y : bool; z : bool}. + +Goal forall x1 x2 y z, + {| x := x1; y := y; z := z |} = {| x := x2; y := y; z := z |} -> x1 = x2. +Proof. +intros; congruence. (* was doing stack overflow *) +Qed. diff --git a/test-suite/bugs/closed/bug_2456.v b/test-suite/bugs/closed/bug_2456.v new file mode 100644 index 0000000000..e5a392c4d3 --- /dev/null +++ b/test-suite/bugs/closed/bug_2456.v @@ -0,0 +1,58 @@ + +Require Import Equality. + +Parameter Patch : nat -> nat -> Set. + +Inductive Catch (from to : nat) : Type + := MkCatch : forall (p : Patch from to), + Catch from to. +Arguments MkCatch [from to]. + +Inductive CatchCommute5 + : forall {from mid1 mid2 to : nat}, + Catch from mid1 + -> Catch mid1 to + -> Catch from mid2 + -> Catch mid2 to + -> Prop + := MkCatchCommute5 : + forall {from mid1 mid2 to : nat} + (p : Patch from mid1) + (q : Patch mid1 to) + (q' : Patch from mid2) + (p' : Patch mid2 to), + CatchCommute5 (MkCatch p) (MkCatch q) (MkCatch q') (MkCatch p'). + +Inductive CatchCommute {from mid1 mid2 to : nat} + (p : Catch from mid1) + (q : Catch mid1 to) + (q' : Catch from mid2) + (p' : Catch mid2 to) + : Prop + := isCatchCommute5 : forall (catchCommuteDetails : CatchCommute5 p q q' p'), + CatchCommute p q q' p'. +Notation "<< p , q >> <~> << q' , p' >>" + := (CatchCommute p q q' p') + (at level 60, no associativity). + +Lemma CatchCommuteUnique2 : + forall {from mid mid' to : nat} + {p : Catch from mid} {q : Catch mid to} + {q' : Catch from mid'} {p' : Catch mid' to} + {q'' : Catch from mid'} {p'' : Catch mid' to} + (commute1 : <> <~> <>) + (commute2 : <> <~> <>), + (p' = p'') /\ (q' = q''). +Proof with auto. +intros. +set (X := commute2). +Fail dependent destruction commute1; +dependent destruction catchCommuteDetails; +dependent destruction commute2; +dependent destruction catchCommuteDetails generalizing X. +revert X. +dependent destruction commute1; +dependent destruction catchCommuteDetails; +dependent destruction commute2; +dependent destruction catchCommuteDetails. +Abort. diff --git a/test-suite/bugs/closed/bug_2464.v b/test-suite/bugs/closed/bug_2464.v new file mode 100644 index 0000000000..b9db30359c --- /dev/null +++ b/test-suite/bugs/closed/bug_2464.v @@ -0,0 +1,39 @@ +Require Import FSetWeakList. +Require Import FSetDecide. + +Parameter Name : Set. +Axiom eq_Name_dec : forall (n : Name) (o : Name), {n = o} + {n <> o}. + +Module DecidableName. +Definition t := Name. +Definition eq := @eq Name. +Definition eq_refl := @refl_equal Name. +Definition eq_sym := @sym_eq Name. +Definition eq_trans := @trans_eq Name. +Definition eq_dec := eq_Name_dec. +End DecidableName. + +Module NameSetMod := Make(DecidableName). + +Module NameSetDec := WDecide (NameSetMod). + +Class PartPatchUniverse (pu_type1 pu_type2 : Type) + : Type := mkPartPatchUniverse { +}. +Class PatchUniverse {pu_type : Type} + (ppu : PartPatchUniverse pu_type pu_type) + : Type := mkPatchUniverse { + pu_nameOf : pu_type -> Name +}. + +Lemma foo : forall (pu_type : Type) + (ppu : PartPatchUniverse pu_type pu_type) + (patchUniverse : PatchUniverse ppu) + (ns ns1 ns2 : NameSetMod.t) + (containsOK : NameSetMod.Equal ns1 ns2) + (p : pu_type) + (HX1 : NameSetMod.Equal ns1 (NameSetMod.add (pu_nameOf p) ns)), + NameSetMod.Equal ns2 (NameSetMod.add (pu_nameOf p) ns). +Proof. +NameSetDec.fsetdec. +Qed. diff --git a/test-suite/bugs/closed/bug_2467.v b/test-suite/bugs/closed/bug_2467.v new file mode 100644 index 0000000000..ad17814a8f --- /dev/null +++ b/test-suite/bugs/closed/bug_2467.v @@ -0,0 +1,49 @@ +(* +In the code below, I would expect the + NameSetDec.fsetdec. +to solve the Lemma, but I need to do it in steps instead. + +This is a regression relative to FSet, + +I have v8.3 (13702). +*) + +Require Import Coq.MSets.MSets. + +Parameter Name : Set. +Parameter Name_compare : Name -> Name -> comparison. +Parameter Name_compare_sym : forall {x y : Name}, + Name_compare y x = CompOpp (Name_compare x y). +Parameter Name_compare_trans : forall {c : comparison} + {x y z : Name}, + Name_compare x y = c + -> Name_compare y z = c + -> Name_compare x z = c. +Parameter Name_eq_leibniz : forall {s s' : Name}, + Name_compare s s' = Eq + -> s = s'. + +Module NameOrderedTypeAlt. +Definition t := Name. +Definition compare := Name_compare. +Definition compare_sym := @Name_compare_sym. +Definition compare_trans := @Name_compare_trans. +End NameOrderedTypeAlt. + +Module NameOrderedType := OT_from_Alt(NameOrderedTypeAlt). + +Module NameOrderedTypeWithLeibniz. +Include NameOrderedType. +Definition eq_leibniz := @Name_eq_leibniz. +End NameOrderedTypeWithLeibniz. + +Module NameSetMod := MSetList.MakeWithLeibniz(NameOrderedTypeWithLeibniz). +Module NameSetDec := WDecide (NameSetMod). + +Lemma foo : forall (xs ys : NameSetMod.t) + (n : Name) + (H1 : NameSetMod.Equal xs (NameSetMod.add n ys)), + NameSetMod.In n xs. +Proof. +NameSetDec.fsetdec. +Qed. diff --git a/test-suite/bugs/closed/bug_2473.v b/test-suite/bugs/closed/bug_2473.v new file mode 100644 index 0000000000..48987ea325 --- /dev/null +++ b/test-suite/bugs/closed/bug_2473.v @@ -0,0 +1,40 @@ +Require Import TestSuite.admit. + +Require Import Relations Program Setoid Morphisms. + +Section S1. + Variable R: nat -> relation bool. + Instance HR1: forall n, Transitive (R n). Admitted. + Instance HR2: forall n, Symmetric (R n). Admitted. + Hypothesis H: forall n a, R n (andb a a) a. + Goal forall n a b, R n b a. + intros. + (* rewrite <- H. *) (* Anomaly: Evar ?.. was not declared. Please report. *) + (* idem with setoid_rewrite *) +(* assert (HR2' := HR2 n). *) + rewrite <- H. (* ok *) + admit. + Qed. +End S1. + +Section S2. + Variable R: nat -> relation bool. + Instance HR: forall n, Equivalence (R n). Admitted. + Hypothesis H: forall n a, R n (andb a a) a. + Goal forall n a b, R n a b. + intros. rewrite <- H. admit. + Qed. +End S2. + +(* the parametrised relation is required to get the problem *) +Section S3. + Variable R: relation bool. + Instance HR1': Transitive R. Admitted. + Instance HR2': Symmetric R. Admitted. + Hypothesis H: forall a, R (andb a a) a. + Goal forall a b, R b a. + intros. + rewrite <- H. (* ok *) + admit. + Qed. +End S3. diff --git a/test-suite/bugs/closed/bug_2584.v b/test-suite/bugs/closed/bug_2584.v new file mode 100644 index 0000000000..fe3967ff67 --- /dev/null +++ b/test-suite/bugs/closed/bug_2584.v @@ -0,0 +1,89 @@ +Require Import List. + +Set Implicit Arguments. + +Definition err : Type := unit. + +Inductive res (A: Type) : Type := +| OK: A -> res A +| Error: err -> res A. + +Arguments Error [A]. + +Set Printing Universes. + +Section FOO. + +Inductive ftyp : Type := + | Funit : ftyp + | Ffun : list ftyp -> ftyp + | Fref : area -> ftyp +with area : Type := + | Stored : ftyp -> area +. + +Print ftyp. +(* yields: +Inductive ftyp : Type (* Top.27429 *) := + Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp + with area : Type (* Set *) := Stored : ftyp -> area +*) + +Fixpoint tc_wf_type (ftype: ftyp) {struct ftype}: res unit := + match ftype with + | Funit => OK tt + | Ffun args => + ((fix tc_wf_types (ftypes: list ftyp){struct ftypes}: res unit := + match ftypes with + | nil => OK tt + | t::ts => + match tc_wf_type t with + | OK tt => tc_wf_types ts + | Error m => Error m + end + end) args) + | Fref a => tc_wf_area a + end +with tc_wf_area (ar:area): res unit := + match ar with + | Stored c => tc_wf_type c + end. + +End FOO. + +Print ftyp. +(* yields: +Inductive ftyp : Type (* Top.27465 *) := + Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp + with area : Set := Stored : ftyp -> area +*) + +Fixpoint tc_wf_type' (ftype: ftyp) {struct ftype}: res unit := + match ftype with + | Funit => OK tt + | Ffun args => + ((fix tc_wf_types (ftypes: list ftyp){struct ftypes}: res unit := + match ftypes with + | nil => OK tt + | t::ts => + match tc_wf_type' t with + | OK tt => tc_wf_types ts + | Error m => Error m + end + end) args) + | Fref a => tc_wf_area' a + end +with tc_wf_area' (ar:area): res unit := + match ar with + | Stored c => tc_wf_type' c + end. + +(* yields: +Error: +Incorrect elimination of "ar" in the inductive type "area": +the return type has sort "Type (* max(Set, Top.27424) *)" while it +should be "Prop" or "Set". +Elimination of an inductive object of sort Set +is not allowed on a predicate in sort Type +because strong elimination on non-small inductive types leads to paradoxes. +*) diff --git a/test-suite/bugs/closed/bug_2586.v b/test-suite/bugs/closed/bug_2586.v new file mode 100644 index 0000000000..e57bcc25bb --- /dev/null +++ b/test-suite/bugs/closed/bug_2586.v @@ -0,0 +1,6 @@ +Require Import Setoid SetoidClass Program. + +Goal forall `(Setoid nat) x y, x == y -> S x == S y. + intros. + Fail clsubst H0. + Abort. diff --git a/test-suite/bugs/closed/bug_2590.v b/test-suite/bugs/closed/bug_2590.v new file mode 100644 index 0000000000..504b453e92 --- /dev/null +++ b/test-suite/bugs/closed/bug_2590.v @@ -0,0 +1,19 @@ +Require Import TestSuite.admit. +Require Import Relation_Definitions RelationClasses Setoid SetoidClass. + +Section Bug. + + Context {A : Type} (R : relation A). + Hypothesis pre : PreOrder R. + Context `{SA : Setoid A}. + + Goal True. + set (SA' := SA). + assert ( forall SA0 : Setoid A, + @PartialOrder A (@equiv A SA0) (@setoid_equiv A SA0) R pre ). + rename SA into SA0. + intro SA. + admit. + admit. +Qed. +End Bug. diff --git a/test-suite/bugs/closed/bug_2602.v b/test-suite/bugs/closed/bug_2602.v new file mode 100644 index 0000000000..29c8ac16b2 --- /dev/null +++ b/test-suite/bugs/closed/bug_2602.v @@ -0,0 +1,8 @@ +Goal exists m, S m > 0. +eexists. +match goal with + | |- context [ S ?a ] => + match goal with + | |- S a > 0 => idtac + end +end. diff --git a/test-suite/bugs/closed/bug_2603.v b/test-suite/bugs/closed/bug_2603.v new file mode 100644 index 0000000000..371bfdc575 --- /dev/null +++ b/test-suite/bugs/closed/bug_2603.v @@ -0,0 +1,33 @@ +(** Namespace of module vs. namescope of definitions/constructors/... + +As noticed by A. Appel in bug #2603, module names and definition +names used to be in the same namespace. But conflict with names +of constructors (or 2nd mutual inductive...) used to not be checked +enough, leading to stange situations. + +- In 8.3pl3 we introduced checks that forbid uniformly the following + situations. + +- For 8.4 we finally managed to make module names and other names + live in two separate namespace, hence allowing all of the following + situations. +*) + +Module Type T. +End T. + +Declare Module K : T. + +Module Type L. +Declare Module E : T. +End L. + +Module M1 : L with Module E:=K. +Module E := K. +Inductive t := E. (* Used to be accepted, but End M1 below was failing *) +End M1. + +Module M2 : L with Module E:=K. +Inductive t := E. +Module E := K. (* Used to be accepted *) +End M2. (* Used to be accepted *) diff --git a/test-suite/bugs/closed/bug_2608.v b/test-suite/bugs/closed/bug_2608.v new file mode 100644 index 0000000000..a4c95ff97c --- /dev/null +++ b/test-suite/bugs/closed/bug_2608.v @@ -0,0 +1,34 @@ + +Module Type T. + Parameter Inline t : Type. +End T. + +Module M. + Definition t := nat. +End M. + +Module Make (X:T). + Include X. + + (* here t is : (Top.Make.t,Top.X.t) *) + + (* in libobject HEAD : EvalConstRef (Top.X.t,Top.X.t) + which is substituted by : {Top.X |-> Top.Make [, Top.Make.t=>Top.X.t]} + which gives : EvalConstRef (Top.Make.t,Top.X.t) *) + +End Make. + +Module P := Make M. + + (* resolver returned by add_module : Top.P.t=>inline *) + (* then constant_of_delta_kn P.t produces (Top.P.t,Top.P.t) *) + + (* in libobject HEAD : EvalConstRef (Top.Make.t,Top.X.t) + given to subst = { |-> Top.M [, Top.M.t=>inline]} + which used to give : EvalConstRef (Top.Make.t,Top.M.t) + given to subst = {Top.Make |-> Top.P [, Top.P.t=>inline]} + which used to give : EvalConstRef (Top.P.t,Top.M.t) *) + +Definition u := P.t. + (* was raising Not_found since Heads.head_map knows of (Top.P.t,Top.M.t) + and not of (Top.P.t,Top.P.t) *) diff --git a/test-suite/bugs/closed/bug_2613.v b/test-suite/bugs/closed/bug_2613.v new file mode 100644 index 0000000000..6307dae1b2 --- /dev/null +++ b/test-suite/bugs/closed/bug_2613.v @@ -0,0 +1,17 @@ +Require Import TestSuite.admit. +(* Check that eq_sym is still pointing to Logic.eq_sym after use of Function *) + +Require Import ZArith. +Require Recdef. + +Axiom nat_eq_dec: forall x y : nat, {x=y}+{x<>y}. + +Locate eq_sym. (* Constant Coq.Init.Logic.eq_sym *) + +Function loop (n: nat) {measure (fun x => x) n} : bool := + if nat_eq_dec n 0 then false else loop (pred n). +Proof. + admit. +Defined. + +Check eq_sym eq_refl : 0=0. diff --git a/test-suite/bugs/closed/bug_2615.v b/test-suite/bugs/closed/bug_2615.v new file mode 100644 index 0000000000..7197d917bd --- /dev/null +++ b/test-suite/bugs/closed/bug_2615.v @@ -0,0 +1,17 @@ +Require Import TestSuite.admit. +(* This failed with an anomaly in pre-8.4 because of let-in not + properly taken into account in the test for unification pattern *) + +Inductive foo : forall A, A -> Prop := +| foo_intro : forall A x, foo A x. +Lemma bar A B f : foo (A -> B) f -> forall x : A, foo B (f x). +Fail induction 1. + +(* Whether these examples should succeed with a non-dependent return predicate + or fail because there is well-typed return predicate dependent in f + is questionable. As of 25 oct 2011, they succeed *) +refine (fun p => match p with _ => _ end). +Undo. +refine (fun p => match p with foo_intro _ _ => _ end). +admit. +Qed. diff --git a/test-suite/bugs/closed/bug_2616.v b/test-suite/bugs/closed/bug_2616.v new file mode 100644 index 0000000000..0be5b6c2c5 --- /dev/null +++ b/test-suite/bugs/closed/bug_2616.v @@ -0,0 +1,7 @@ +(* Testing ill-typed rewrite which used to succeed in 8.3 *) +Goal + forall (N : nat -> Prop) (g : nat -> sig N) (IN : forall a : sig N, a = g 0), + N 0 -> False. +Proof. +intros. +Fail rewrite IN in H. diff --git a/test-suite/bugs/closed/bug_2629.v b/test-suite/bugs/closed/bug_2629.v new file mode 100644 index 0000000000..759cd3dd28 --- /dev/null +++ b/test-suite/bugs/closed/bug_2629.v @@ -0,0 +1,22 @@ +Class Join (t: Type) : Type := mkJoin {join: t -> t -> t -> Prop}. + +Class sepalg (t: Type) {JOIN: Join t} : Type := + SepAlg { + join_eq: forall {x y z z'}, join x y z -> join x y z' -> z = z'; + join_assoc: forall {a b c d e}, join a b d -> join d c e -> + {f : t & join b c f /\ join a f e}; + join_com: forall {a b c}, join a b c -> join b a c; + join_canc: forall {a1 a2 b c}, join a1 b c -> join a2 b c -> a1=a2; + + unit_for : t -> t -> Prop := fun e a => join e a a; + join_ex_units: forall a, {e : t & unit_for e a} +}. + +Definition joins {A} `{Join A} (a b : A) : Prop := + exists c, join a b c. + +Lemma join_joins {A} `{sepalg A}: forall {a b c}, + join a b c -> joins a b. +Proof. + firstorder. +Qed. diff --git a/test-suite/bugs/closed/bug_2667.v b/test-suite/bugs/closed/bug_2667.v new file mode 100644 index 0000000000..0e6d0108cc --- /dev/null +++ b/test-suite/bugs/closed/bug_2667.v @@ -0,0 +1,11 @@ +(* Check that extra arguments to Arguments do not disturb use of *) +(* scopes in constructors *) + +Inductive stmt : Type := Sskip: stmt | Scall : nat -> stmt. +Bind Scope Cminor with stmt. + +(* extra argument is ok because of possible coercion to funclass *) +Arguments Scall _ _%Cminor : extra scopes. + +(* extra argument is ok because of possible coercion to funclass *) +Fixpoint f (c: stmt) : Prop := match c with Scall _ => False | _ => False end. diff --git a/test-suite/bugs/closed/bug_2668.v b/test-suite/bugs/closed/bug_2668.v new file mode 100644 index 0000000000..d5bbfd3f08 --- /dev/null +++ b/test-suite/bugs/closed/bug_2668.v @@ -0,0 +1,6 @@ +Require Import MSetPositive. +Require Import MSetProperties. + +Module Pos := MSetPositive.PositiveSet. +Module PPPP := MSetProperties.WPropertiesOn(Pos). +Print Module PPPP. diff --git a/test-suite/bugs/closed/bug_2670.v b/test-suite/bugs/closed/bug_2670.v new file mode 100644 index 0000000000..791889b24b --- /dev/null +++ b/test-suite/bugs/closed/bug_2670.v @@ -0,0 +1,29 @@ +(* Check that problems with several solutions are solved in 8.4 as in 8.2 and 8.3 *) + +Inductive Fin: nat -> Set := +| first k : Fin (S k) +| succ k: Fin k -> Fin (S k). + +Lemma match_sym_eq_eq: forall (n1 n2: nat)(f: Fin n1)(e: n1 = n2), +f = match sym_eq e in (_ = l) return (Fin l) with refl_equal => + match e in (_ = l) return (Fin l) with refl_equal => f end end. +Proof. + intros n1 n2 f e. + (* Next line has a dependent and a non dependent solution *) + (* 8.2 and 8.3 used to choose the dependent one which is the one to make *) + (* the goal progress *) + refine (match e return _ with refl_equal => _ end). + reflexivity. + Undo 2. + (** Check insensitivity to alphabetic order *) + refine (match e as a in _ = b return _ with refl_equal => _ end). + reflexivity. + Undo 2. + (** Check insensitivity to alphabetic order *) + refine (match e as z in _ = y return _ with refl_equal => _ end). + reflexivity. + Undo 2. + (* Next line similarly has a dependent and a non dependent solution *) + refine (match e with refl_equal => _ end). + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_2680.v b/test-suite/bugs/closed/bug_2680.v new file mode 100644 index 0000000000..e5319f3b4d --- /dev/null +++ b/test-suite/bugs/closed/bug_2680.v @@ -0,0 +1,15 @@ +(* Tauto bug initially due to wrong test for binary connective *) + +Parameter A B : Type. + +Axiom P : A -> B -> Prop. + +Inductive IP (a : A) (b: B) : Prop := +| IP_def : P a b -> IP a b. + + +Goal forall (a : A) (b : B), IP a b -> ~ IP a b -> False. +Proof. + intros. + tauto. +Qed. diff --git a/test-suite/bugs/closed/bug_2713.v b/test-suite/bugs/closed/bug_2713.v new file mode 100644 index 0000000000..c8d4c6cecd --- /dev/null +++ b/test-suite/bugs/closed/bug_2713.v @@ -0,0 +1,17 @@ +Set Implicit Arguments. + +Definition pred_le A (P Q : A->Prop) := + forall x, P x -> Q x. + +Lemma pred_le_refl : forall A (P:A->Prop), + pred_le P P. +Proof. unfold pred_le. auto. Qed. + +Hint Resolve pred_le_refl. + +Lemma test : + forall (P1 P2:nat->Prop), + (forall Q, pred_le (fun a => P1 a /\ P2 a) Q -> True) -> + True. +Proof. intros. eapply H. eauto. (* used to work *) + apply pred_le_refl. Qed. diff --git a/test-suite/bugs/closed/bug_2729.v b/test-suite/bugs/closed/bug_2729.v new file mode 100644 index 0000000000..c9d65c12c7 --- /dev/null +++ b/test-suite/bugs/closed/bug_2729.v @@ -0,0 +1,115 @@ +(* This bug report actually revealed two bugs in the reconstruction of + a term with "match" in the vm *) + +(* A simplified form of the first problem *) + +(* Reconstruction of terms normalized with vm when a constructor has *) +(* let-ins arguments *) + +Record A : Type := C { a := 0 : nat; b : a=a }. +Goal forall d:A, match d with C a b => b end = match d with C a b => b end. +intro. +vm_compute. +(* Now check that it is well-typed *) +match goal with |- ?c = _ => first [let x := type of c in idtac | fail 2] end. +Abort. + +(* A simplified form of the second problem *) + +Parameter P : nat -> Type. + +Inductive box A := Box : A -> box A. + +Axiom com : {m : nat & box (P m) }. + +Lemma L : + (let (w, s) as com' return (com' = com -> Prop) := com in + let (s0) as s0 + return (existT (fun m : nat => box (P m)) w s0 = com -> Prop) := s in + fun _ : existT (fun m : nat => box (P m)) w (Box (P w) s0) = com => + True) eq_refl. +Proof. +vm_compute. +(* Now check that it is well-typed (the "P w" used to be turned into "P s") *) +match goal with |- ?c => first [let x := type of c in idtac | fail 2] end. +Abort. + +(* Then the original report *) + +Require Import Equality. + +Parameter NameSet : Set. +Parameter SignedName : Set. +Parameter SignedName_compare : forall (x y : SignedName), comparison. +Parameter pu_type : NameSet -> NameSet -> Type. +Parameter pu_nameOf : forall {from to : NameSet}, pu_type from to -> SignedName. +Parameter commute : forall {from mid1 mid2 to : NameSet}, + pu_type from mid1 -> pu_type mid1 to + -> pu_type from mid2 -> pu_type mid2 to -> Prop. + +Program Definition castPatchFrom {from from' to : NameSet} + (HeqFrom : from = from') + (p : pu_type from to) + : pu_type from' to + := p. + +Class PatchUniverse : Type := mkPatchUniverse { + + commutable : forall {from mid1 to : NameSet}, + pu_type from mid1 -> pu_type mid1 to -> Prop + := fun {from mid1 to : NameSet} + (p : pu_type from mid1) (q : pu_type mid1 to) => + exists mid2 : NameSet, + exists q' : pu_type from mid2, + exists p' : pu_type mid2 to, + commute p q q' p'; + + commutable_dec : forall {from mid to : NameSet} + (p : pu_type from mid) + (q : pu_type mid to), + {mid2 : NameSet & + { q' : pu_type from mid2 & + { p' : pu_type mid2 to & + commute p q q' p' }}} + + {~(commutable p q)} +}. + +Inductive SequenceBase (pu : PatchUniverse) + : NameSet -> NameSet -> Type + := Nil : forall {cxt : NameSet}, + SequenceBase pu cxt cxt + | Cons : forall {from mid to : NameSet} + (p : pu_type from mid) + (qs : SequenceBase pu mid to), + SequenceBase pu from to. +Arguments Nil [pu cxt]. +Arguments Cons [pu from mid to]. + +Program Fixpoint insertBase {pu : PatchUniverse} + {from mid to : NameSet} + (p : pu_type from mid) + (qs : SequenceBase pu mid to) + : SequenceBase pu from to + := match qs with + | Nil => Cons p Nil + | Cons q qs' => + match SignedName_compare (pu_nameOf p) (pu_nameOf q) with + | Lt => Cons p qs + | _ => match commutable_dec p (castPatchFrom _ q) with + | inleft (existT _ _ (existT _ q' (existT _ p' _))) => Cons q' +(insertBase p' qs') + | inright _ => Cons p qs + end + end + end. + +Lemma insertBaseConsLt {pu : PatchUniverse} + {o op opq opqr : NameSet} + (p : pu_type o op) + (q : pu_type op opq) + (rs : SequenceBase pu opq opqr) + (p_Lt_q : SignedName_compare (pu_nameOf p) (pu_nameOf q) += Lt) + : insertBase p (Cons q rs) = Cons p (Cons q rs). +Proof. +vm_compute. diff --git a/test-suite/bugs/closed/bug_2732.v b/test-suite/bugs/closed/bug_2732.v new file mode 100644 index 0000000000..f22a8cccc5 --- /dev/null +++ b/test-suite/bugs/closed/bug_2732.v @@ -0,0 +1,19 @@ +(* Check correct behavior of add_primitive_tactic in TACEXTEND *) + +(* Added also the case of eauto and congruence *) + +Ltac thus H := solve [H]. + +Lemma test: forall n : nat, n <= n. +Proof. + intro. + thus firstorder. + Undo. + thus eauto. +Qed. + +Lemma test2: false = true -> False. +Proof. + intro. + thus congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_2733.v b/test-suite/bugs/closed/bug_2733.v new file mode 100644 index 0000000000..24dd30b32e --- /dev/null +++ b/test-suite/bugs/closed/bug_2733.v @@ -0,0 +1,43 @@ +Unset Asymmetric Patterns. + +Definition goodid : forall {A} (x: A), A := fun A x => x. +Definition wrongid : forall A (x: A), A := fun {A} x => x. + +Inductive ty := N | B. + +Inductive alt_list : ty -> ty -> Type := + | nil {k} : alt_list k k + | Ncons {k} : nat -> alt_list B k -> alt_list N k + | Bcons {k} : bool -> alt_list N k -> alt_list B k. + +Definition trullynul k {k'} (l : alt_list k k') := +match k,l with + |N,l' => Ncons 0 (Bcons true l') + |B,l' => Bcons true (Ncons 0 l') +end. + +(* At some time, the success of trullynul was dependent on the name of + the variables! *) + +Definition trullynul2 k {a} (l : alt_list k a) := +match k,l with + |N,l' => Ncons 0 (Bcons true l') + |B,l' => Bcons true (Ncons 0 l') +end. + +Definition trullynul3 k {z} (l : alt_list k z) := +match k,l with + |N,l' => Ncons 0 (Bcons true l') + |B,l' => Bcons true (Ncons 0 l') +end. + +Fixpoint app (P : forall {k k'}, alt_list k k' -> alt_list k k') {t1 t2} (l : alt_list t1 t2) {struct l}: forall {t3}, alt_list t2 t3 -> +alt_list t1 t3 := + match l with + | nil => fun _ l2 => P l2 + | Ncons n l1 => fun _ l2 => Ncons n (app (@P) l1 l2) + | Bcons b l1 => fun _ l2 => Bcons b (app (@P) l1 l2) + end. + +Check (fun {t t'} (l: alt_list t t') => + app trullynul (goodid l) (wrongid _ nil)). diff --git a/test-suite/bugs/closed/bug_2734.v b/test-suite/bugs/closed/bug_2734.v new file mode 100644 index 0000000000..3210214ea1 --- /dev/null +++ b/test-suite/bugs/closed/bug_2734.v @@ -0,0 +1,15 @@ +Require Import Arith List. +Require Import OrderedTypeEx. + +Module Adr. + Include Nat_as_OT. + Definition nat2t (i: nat) : t := i. +End Adr. + +Inductive expr := Const: Adr.t -> expr. + +Inductive control := Go: expr -> control. + +Definition program := (Adr.t * (control))%type. + +Fail Definition myprog : program := (Adr.nat2t 0, Go (Adr.nat2t 0) ). diff --git a/test-suite/bugs/closed/bug_2750.v b/test-suite/bugs/closed/bug_2750.v new file mode 100644 index 0000000000..9d65e51f63 --- /dev/null +++ b/test-suite/bugs/closed/bug_2750.v @@ -0,0 +1,23 @@ + +Module Type ModWithRecord. + + Record foo : Type := + { A : nat + ; B : nat + }. +End ModWithRecord. + +Module Test_ModWithRecord (M : ModWithRecord). + + Definition test1 : M.foo := + {| M.A := 0 + ; M.B := 2 + |}. + + Module B := M. + + Definition test2 : M.foo := + {| M.A := 0 + ; M.B := 2 + |}. +End Test_ModWithRecord. diff --git a/test-suite/bugs/closed/bug_2775.v b/test-suite/bugs/closed/bug_2775.v new file mode 100644 index 0000000000..484ac6fd38 --- /dev/null +++ b/test-suite/bugs/closed/bug_2775.v @@ -0,0 +1,6 @@ +Inductive typ : forall (T:Type), list T -> Type -> Prop := + | Get : forall (T:Type) (l:list T), typ T l T. + + +Derive Inversion inv with +(forall (X: Type) (y: list nat), typ nat y X) Sort Prop. diff --git a/test-suite/bugs/closed/bug_2800.v b/test-suite/bugs/closed/bug_2800.v new file mode 100644 index 0000000000..54c75e344c --- /dev/null +++ b/test-suite/bugs/closed/bug_2800.v @@ -0,0 +1,19 @@ +Goal False. + +intuition + match goal with + | |- _ => idtac " foo" + end. + + lazymatch goal with _ => idtac end. + match goal with _ => idtac end. + unshelve lazymatch goal with _ => idtac end. + unshelve match goal with _ => idtac end. + unshelve (let x := I in idtac). +Abort. + +Require Import ssreflect. + +Goal True. +match goal with _ => idtac end => //. +Qed. diff --git a/test-suite/bugs/closed/bug_2810.v b/test-suite/bugs/closed/bug_2810.v new file mode 100644 index 0000000000..a66078c60a --- /dev/null +++ b/test-suite/bugs/closed/bug_2810.v @@ -0,0 +1,10 @@ +Section foo. + Variable A : Type. + Let B := A. + + Hint Unfold B. + + Goal False. + clear B. autounfold with core. + Abort. +End foo. diff --git a/test-suite/bugs/closed/bug_2814.v b/test-suite/bugs/closed/bug_2814.v new file mode 100644 index 0000000000..99da1e3e44 --- /dev/null +++ b/test-suite/bugs/closed/bug_2814.v @@ -0,0 +1,6 @@ +Require Import Program. + +Goal forall (x : Type) (f g : Type -> Type) (H : f x ~= g x), False. + intros. + Fail induction H. +Abort. diff --git a/test-suite/bugs/closed/bug_2817.v b/test-suite/bugs/closed/bug_2817.v new file mode 100644 index 0000000000..08dff99287 --- /dev/null +++ b/test-suite/bugs/closed/bug_2817.v @@ -0,0 +1,9 @@ +(** Occur-check for Meta (up to application of already known instances) *) + +Goal forall (f: nat -> nat -> Prop) (x:bool) + (H: forall (u: nat), f u u -> True) + (H0: forall x0, f (if x then x0 else x0) x0), +False. + +intros. +Fail apply H in H0. (* should fail without exhausting the stack *) diff --git a/test-suite/bugs/closed/bug_2818.v b/test-suite/bugs/closed/bug_2818.v new file mode 100644 index 0000000000..010855cfb7 --- /dev/null +++ b/test-suite/bugs/closed/bug_2818.v @@ -0,0 +1,11 @@ +Module M. + +Local Ltac t := exact I. +Ltac u := t. + +End M. + +Goal True. +Proof. +M.u. +Qed. diff --git a/test-suite/bugs/closed/bug_2828.v b/test-suite/bugs/closed/bug_2828.v new file mode 100644 index 0000000000..0b8abace22 --- /dev/null +++ b/test-suite/bugs/closed/bug_2828.v @@ -0,0 +1,4 @@ +Parameter A B : Type. +Coercion POL (p : prod A B) := fst p. +Goal forall x : prod A B, A. + intro x. Fail exact x. diff --git a/test-suite/bugs/closed/bug_2830.v b/test-suite/bugs/closed/bug_2830.v new file mode 100644 index 0000000000..801c61b132 --- /dev/null +++ b/test-suite/bugs/closed/bug_2830.v @@ -0,0 +1,227 @@ +(* Bug report #2830 (evar defined twice) covers different bugs *) + +(* 1- This was submitted by qb.h.agws *) + +Module A. + +Set Implicit Arguments. + +Inductive Bit := O | I. + +Inductive BitString: nat -> Set := +| bit: Bit -> BitString 0 +| bitStr: forall n: nat, Bit -> BitString n -> BitString (S n). + +Definition BitOr (a b: Bit) := + match a, b with + | O, O => O + | _, _ => I + end. + +(* Should fail with an error; used to failed in 8.4 and trunk with + anomaly Evd.define: cannot define an evar twice *) + +Fail Fixpoint StringOr (n m: nat) (a: BitString n) (b: BitString m) := + match a with + | bit a' => + match b with + | bit b' => bit (BitOr a' b') + | bitStr b' bT => bitStr b' (StringOr (bit a') bT) + end + | bitStr a' aT => + match b with + | bit b' => bitStr a' (StringOr aT (bit b')) + | bitStr b' bT => bitStr (BitOr a' b') (StringOr aT bT) + end + end. + +End A. + +(* 2- This was submitted by Andrew Appel *) + +Module B. + +Require Import Program Relations. + +Record ageable_facts (A:Type) (level: A -> nat) (age1:A -> option A) := +{ af_unage : forall x x' y', level x' = level y' -> age1 x = Some x' -> exists y, age1 y = Some y' +; af_level1 : forall x, age1 x = None <-> level x = 0 +; af_level2 : forall x y, age1 x = Some y -> level x = S (level y) +}. + +Arguments af_unage {A level age1}. +Arguments af_level1 {A level age1}. +Arguments af_level2 {A level age1}. + +Class ageable (A:Type) := mkAgeable +{ level : A -> nat +; age1 : A -> option A +; age_facts : ageable_facts A level age1 +}. +Definition age {A} `{ageable A} (x y:A) := age1 x = Some y. +Definition necR {A} `{ageable A} : relation A := clos_refl_trans A age. +Delimit Scope pred with pred. +Local Open Scope pred. + +Definition hereditary {A} (R:A->A->Prop) (p:A->Prop) := + forall a a':A, R a a' -> p a -> p a'. + +Definition pred (A:Type) {AG:ageable A} := + { p:A -> Prop | hereditary age p }. + +Bind Scope pred with pred. + +Definition app_pred {A} `{ageable A} (p:pred A) : A -> Prop := proj1_sig p. +Definition pred_hereditary `{ageable} (p:pred A) := proj2_sig p. +Coercion app_pred : pred >-> Funclass. +Global Opaque pred. + +Definition derives {A} `{ageable A} (P Q:pred A) := forall a:A, P a -> Q a. +Arguments derives : default implicits. + +Program Definition andp {A} `{ageable A} (P Q:pred A) : pred A := + fun a:A => P a /\ Q a. +Next Obligation. + intros; intro; intuition; apply pred_hereditary with a; auto. +Qed. + +Program Definition imp {A} `{ageable A} (P Q:pred A) : pred A := + fun a:A => forall a':A, necR a a' -> P a' -> Q a'. +Next Obligation. + intros; intro; intuition. + apply H1; auto. + apply rt_trans with a'; auto. + apply rt_step; auto. +Qed. + +Program Definition allp {A} `{ageable A} {B: Type} (f: B -> pred A) : pred A + := fun a => forall b, f b a. +Next Obligation. + intros; intro; intuition. + apply pred_hereditary with a; auto. + apply H1. +Qed. + +Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : pred. +Notation "P '|--' Q" := (derives P Q) (at level 80, no associativity). +Notation "'All' x ':' T ',' P " := (allp (fun x:T => P%pred)) (at level 65, x at level 99) : pred. + +Lemma forall_pred_ext {A} `{agA : ageable A}: forall B P Q, + (All x : B, (P x <--> Q x)) |-- (All x : B, P x) <--> (All x: B, Q x). +Abort. + +End B. + +(* 3. *) + +(* This was submitted by Anthony Cowley *) + +Require Import Coq.Classes.Morphisms. +Require Import Setoid. + +Module C. + +Reserved Notation "a ~> b" (at level 70, right associativity). +Reserved Notation "a ≈ b" (at level 54). +Reserved Notation "a ∘ b" (at level 50, left associativity). +Generalizable All Variables. + +Class Category (Object:Type) (Hom:Object -> Object -> Type) := { + hom := Hom where "a ~> b" := (hom a b) : category_scope + ; ob := Object + ; id : forall a, hom a a + ; comp : forall c b a, hom b c -> hom a b -> hom a c + where "g ∘ f" := (comp _ _ _ g f) : category_scope + ; eqv : forall a b, hom a b -> hom a b -> Prop + where "f ≈ g" := (eqv _ _ f g) : category_scope + ; eqv_equivalence : forall a b, Equivalence (eqv a b) + ; comp_respects : forall a b c, + Proper (eqv b c ==> eqv a b ==> eqv a c) (comp c b a) + ; left_identity : forall `(f:a ~> b), id b ∘ f ≈ f + ; right_identity : forall `(f:a ~> b), f ∘ id a ≈ f + ; associativity : forall `(f:a~>b) `(g:b~>c) `(h:c~>d), + h ∘ (g ∘ f) ≈ (h ∘ g) ∘ f +}. +Notation "a ~> b" := (@hom _ _ _ a b) : category_scope. +Notation "g ∘ f" := (@comp _ _ _ _ _ _ g f) : category_scope. +Notation "a ≈ b" := (@eqv _ _ _ _ _ a b) : category_scope. +Notation "a ~{ C }~> b" := (@hom _ _ C a b) (at level 100) : category_scope. +Coercion ob : Category >-> Sortclass. + +Open Scope category_scope. + +Add Parametric Relation `(C:Category Ob Hom) (a b : Ob) : (hom a b) (eqv a b) + reflexivity proved by (@Equivalence_Reflexive _ _ (eqv_equivalence a b)) + symmetry proved by (@Equivalence_Symmetric _ _ (eqv_equivalence a b)) + transitivity proved by (@Equivalence_Transitive _ _ (eqv_equivalence a b)) + as parametric_relation_eqv. + +Add Parametric Morphism `(C:Category Ob Hom) (c b a : Ob) : (comp c b a) + with signature (eqv _ _ ==> eqv _ _ ==> eqv _ _) as parametric_morphism_comp. + intros x y Heq x' y'. apply comp_respects. exact Heq. + Defined. + +Class Functor `(C:Category) `(D:Category) (im : C -> D) := { + functor_im := im + ; fmap : forall {a b}, `(a ~> b) -> im a ~> im b + ; fmap_respects : forall a b (f f' : a ~> b), f ≈ f' -> fmap f ≈ fmap f' + ; fmap_preserves_id : forall a, fmap (id a) ≈ id (im a) + ; fmap_preserves_comp : forall `(f:a~>b) `(g:b~>c), + fmap g ∘ fmap f ≈ fmap (g ∘ f) +}. +Coercion functor_im : Functor >-> Funclass. +Arguments fmap [Object Hom C Object0 Hom0 D im] _ [a b]. + +Add Parametric Morphism `(C:Category) `(D:Category) + (Im:C->D) (F:Functor C D Im) (a b:C) : (@fmap _ _ C _ _ D Im F a b) + with signature (@eqv C _ C a b ==> @eqv D _ D (Im a) (Im b)) + as parametric_morphism_fmap. +intros. apply fmap_respects. assumption. Qed. + +(* HERE IS THE PROBLEMATIC INSTANCE. If we change this to a regular Definition, + then the problem goes away. *) +Instance functor_comp `{C:Category} `{D:Category} `{E:Category} + {Gim} (G:Functor D E Gim) {Fim} (F:Functor C D Fim) + : Functor C E (Basics.compose Gim Fim). +intros. apply Build_Functor with (fmap := fun a b f => fmap G (fmap F f)). +abstract (intros; rewrite H; reflexivity). +abstract (intros; repeat (rewrite fmap_preserves_id); reflexivity). +abstract (intros; repeat (rewrite fmap_preserves_comp); reflexivity). +Defined. + +Definition skel {A:Type} : relation A := @eq A. +Instance skel_equiv A : Equivalence (@skel A). +Admitted. + +Import FunctionalExtensionality. +Instance set_cat : Category Type (fun A B => A -> B) := { + id := fun A => fun x => x + ; comp c b a f g := fun x => f (g x) + ; eqv := fun A B => @skel (A -> B) +}. +intros. compute. symmetry. apply eta_expansion. +intros. compute. symmetry. apply eta_expansion. +intros. compute. reflexivity. Defined. + +(* The [list] type constructor is a Functor. *) + +Import List. + +Definition setList (A:set_cat) := list A. +Instance list_functor : Functor set_cat set_cat setList. +apply Build_Functor with (fmap := @map). +intros. rewrite H. reflexivity. +intros; simpl; apply functional_extensionality. + induction x; [auto|simpl]. rewrite IHx. reflexivity. +intros; simpl; apply functional_extensionality. + induction x; [auto|simpl]. rewrite IHx. reflexivity. +Defined. + +Local Notation "[ a , .. , b ]" := (a :: .. (b :: nil) ..) : list_scope. +Definition setFmap {Fim} {F:Functor set_cat set_cat Fim} `(f:A~>B) (xs:Fim A) := fmap F f xs. + +(* We want to infer the [Functor] instance based on the value's + structure, but the [functor_comp] instance throws things awry. *) +Eval cbv in setFmap (fun x => x * 3) [67,8]. + +End C. diff --git a/test-suite/bugs/closed/bug_2834.v b/test-suite/bugs/closed/bug_2834.v new file mode 100644 index 0000000000..6015c53b8a --- /dev/null +++ b/test-suite/bugs/closed/bug_2834.v @@ -0,0 +1,4 @@ +(* Testing typing of subst *) + +Lemma eqType2Set (a b : Set) (H : @eq Type a b) : @eq Set a b. +Fail subst. diff --git a/test-suite/bugs/closed/bug_2836.v b/test-suite/bugs/closed/bug_2836.v new file mode 100644 index 0000000000..a948b75e27 --- /dev/null +++ b/test-suite/bugs/closed/bug_2836.v @@ -0,0 +1,39 @@ +(* Check that possible instantiation made during evar materialization + are taken into account and do not raise Not_found *) + +Set Implicit Arguments. + +Record SpecializedCategory (obj : Type) (Morphism : obj -> obj -> Type) := { + Object :> _ := obj; + + Identity' : forall o, Morphism o o; + Compose' : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' +}. + +Section SpecializedCategoryInterface. + Variable obj : Type. + Variable mor : obj -> obj -> Type. + Variable C : @SpecializedCategory obj mor. + + Definition Morphism (s d : C) := mor s d. + Definition Identity (o : C) : Morphism o o := C.(Identity') o. + Definition Compose (s d d' : C) (m : Morphism d d') (m0 : Morphism s d) : +Morphism s d' := C.(Compose') s d d' m m0. +End SpecializedCategoryInterface. + +Section ProductCategory. + Variable objC : Type. + Variable morC : objC -> objC -> Type. + Variable objD : Type. + Variable morD : objD -> objD -> Type. + Variable C : SpecializedCategory morC. + Variable D : SpecializedCategory morD. + +(* Should fail nicely *) +Definition ProductCategory : @SpecializedCategory (objC * objD)%type (fun s d +=> (morC (fst s) (fst d) * morD (snd s) (snd d))%type). +Fail refine {| + Identity' := (fun o => (Identity (fst o), Identity (snd o))); + Compose' := (fun s d d' m2 m1 => (Compose (fst m2) (fst m1), Compose (snd +m2) (snd m1))) + |}. diff --git a/test-suite/bugs/closed/bug_2837.v b/test-suite/bugs/closed/bug_2837.v new file mode 100644 index 0000000000..52a56c2cff --- /dev/null +++ b/test-suite/bugs/closed/bug_2837.v @@ -0,0 +1,15 @@ +Require Import JMeq. + +Axiom test : forall n m : nat, JMeq n m. + +Goal forall n m : nat, JMeq n m. + +(* I) with no intros nor variable hints, this should produce a regular error + instead of Uncaught exception Failure("nth"). *) +Fail rewrite test. + +(* II) with intros but indication of variables, still an error *) +Fail (intros; rewrite test). + +(* III) a working variant: *) +intros; rewrite (test n m). diff --git a/test-suite/bugs/closed/bug_2839.v b/test-suite/bugs/closed/bug_2839.v new file mode 100644 index 0000000000..e727e26061 --- /dev/null +++ b/test-suite/bugs/closed/bug_2839.v @@ -0,0 +1,10 @@ +(* Check a case where ltac typing error should result in error, not anomaly *) + +Goal forall (H : forall x : nat, x = x), False. +intro. +Fail + let H := + match goal with + | [ H : context G [@eq _ _] |- _ ] => let H' := context G[@plus 2] in H' + end + in pose H. diff --git a/test-suite/bugs/closed/bug_2846.v b/test-suite/bugs/closed/bug_2846.v new file mode 100644 index 0000000000..8d6d348a2e --- /dev/null +++ b/test-suite/bugs/closed/bug_2846.v @@ -0,0 +1,3 @@ +Variable R : Type. + +Fail Inductive I : R := c : R. diff --git a/test-suite/bugs/closed/bug_2848.v b/test-suite/bugs/closed/bug_2848.v new file mode 100644 index 0000000000..e234630332 --- /dev/null +++ b/test-suite/bugs/closed/bug_2848.v @@ -0,0 +1,10 @@ +Require Import Setoid. + +Parameter value' : Type. +Parameter equiv' : value' -> value' -> Prop. +Axiom cheat : forall {A}, A. +Add Parametric Relation : _ equiv' + reflexivity proved by (Equivalence.equiv_reflexive cheat) + transitivity proved by (Equivalence.equiv_transitive cheat) + as apply_equiv'_rel. +Check apply_equiv'_rel : PreOrder equiv'. diff --git a/test-suite/bugs/closed/bug_2854.v b/test-suite/bugs/closed/bug_2854.v new file mode 100644 index 0000000000..14aee17ff0 --- /dev/null +++ b/test-suite/bugs/closed/bug_2854.v @@ -0,0 +1,7 @@ +Section foo. + Let foo := Type. + Definition bar : foo -> foo := @id _. + Goal False. + subst foo. + Fail pose bar as f. + (* simpl in f. *) diff --git a/test-suite/bugs/closed/bug_2876.v b/test-suite/bugs/closed/bug_2876.v new file mode 100644 index 0000000000..c7df59e86b --- /dev/null +++ b/test-suite/bugs/closed/bug_2876.v @@ -0,0 +1,11 @@ +Lemma test_bug : forall (R:nat->nat->Prop) n m m' (P: Prop), + P -> + (P -> R n m) -> + (P -> R n m') -> + (forall u, R n u -> u = u -> True) -> + True. +Proof. + intros * HP H1 H2 H3. eapply H3. + eauto. (* H1 is used, but H2 should be used since it is the last hypothesis *) + auto. +Qed. diff --git a/test-suite/bugs/closed/bug_2881.v b/test-suite/bugs/closed/bug_2881.v new file mode 100644 index 0000000000..b4f09305b4 --- /dev/null +++ b/test-suite/bugs/closed/bug_2881.v @@ -0,0 +1,7 @@ +(* About scoping of pattern variables in strict/non-strict mode *) + +Ltac eta_red := change (fun a => ?f0 a) with f0. +Goal forall T1 T2 (f : T1 -> T2), (fun x => f x) = f. +intros. +eta_red. +Abort. diff --git a/test-suite/bugs/closed/bug_2883.v b/test-suite/bugs/closed/bug_2883.v new file mode 100644 index 0000000000..f027b5eb29 --- /dev/null +++ b/test-suite/bugs/closed/bug_2883.v @@ -0,0 +1,35 @@ +Require Import TestSuite.admit. +Require Import List. +Require Import Coq.Program.Equality. + +Inductive star {genv state : Type} + (step : genv -> state -> state -> Prop) + (ge : genv) : state -> state -> Prop := + | star_refl : forall s : state, star step ge s s + | star_step : + forall (s1 : state) (s2 : state) + (s3 : state), + step ge s1 s2 -> + star step ge s2 s3 -> + star step ge s1 s3. + +Parameter genv expr env mem : Type. +Definition genv' := genv. +Inductive state : Type := + | State : expr -> env -> mem -> state. +Parameter step : genv' -> state -> state -> Prop. + +Section Test. + +Variable ge : genv'. + +Lemma compat_eval_steps: + forall a b e a' b', + star step ge (State a e b) (State a' e b') -> + True. +Proof. + intros. dependent induction H. + trivial. + eapply IHstar; eauto. + replace s2 with (State a' e b') by admit. eauto. +Qed. (* Oups *) diff --git a/test-suite/bugs/closed/bug_2900.v b/test-suite/bugs/closed/bug_2900.v new file mode 100644 index 0000000000..8f4264e910 --- /dev/null +++ b/test-suite/bugs/closed/bug_2900.v @@ -0,0 +1,28 @@ +(* Was raising stack overflow in 8.4 and assertion failed in future 8.5 *) +Set Implicit Arguments. + +Require Import List. +Require Import Coq.Program.Equality. + +(** Reflexive-transitive closure ( R* ) *) + +Inductive rtclosure (A : Type) (R : A-> A->Prop) : A->A->Prop := + | rtclosure_refl : forall x, + rtclosure R x x + | rtclosure_step : forall y x z, + R x y -> rtclosure R y z -> rtclosure R x z. + (* bug goes away if rtclosure_step is commented out *) + +(** The closure of the trivial binary relation [eq] *) + +Definition tr (A:Type) := rtclosure (@eq A). + +(** The bug *) + +Lemma bug : forall A B (l t:list A) (r s:list B), + length l = length r -> + tr (combine l r) (combine t s) -> tr l t. +Proof. + intros * E Hp. + (* bug goes away if [revert E] is called explicitly *) + dependent induction Hp. diff --git a/test-suite/bugs/closed/bug_2920.v b/test-suite/bugs/closed/bug_2920.v new file mode 100644 index 0000000000..13548b9e44 --- /dev/null +++ b/test-suite/bugs/closed/bug_2920.v @@ -0,0 +1,2 @@ +Fail Definition my_f_equal {A B : Type} (f : A -> B) (a a' : A) (p : a = a') : f a = f a' := + eq_ind _ _ (fun a' => f a = f a') _ _ p. diff --git a/test-suite/bugs/closed/bug_2923.v b/test-suite/bugs/closed/bug_2923.v new file mode 100644 index 0000000000..8a0003a397 --- /dev/null +++ b/test-suite/bugs/closed/bug_2923.v @@ -0,0 +1,12 @@ +Module Type SIGNATURE1. + Inductive IndType: Set := + | AConstructor. +End SIGNATURE1. + +Module Type SIGNATURE2. + Declare Module M1: SIGNATURE1. +End SIGNATURE2. + +Module M2 (Module M1_: SIGNATURE1) : SIGNATURE2. + Module M1 := M1_. +End M2. diff --git a/test-suite/bugs/closed/bug_2928.v b/test-suite/bugs/closed/bug_2928.v new file mode 100644 index 0000000000..21e92ae20c --- /dev/null +++ b/test-suite/bugs/closed/bug_2928.v @@ -0,0 +1,11 @@ +Class Equiv A := equiv: A -> A -> Prop. +Infix "=" := equiv : type_scope. + +Class Associative {A} f `{Equiv A} := associativity x y z : f x (f y z) = f (f x y) z. + +Class SemiGroup A op `{Equiv A} := { sg_ass :>> Associative op }. + +Class SemiLattice A op `{Equiv A} := + { semilattice_sg :>> SemiGroup A op + ; redundant : Associative op + }. diff --git a/test-suite/bugs/closed/bug_2930.v b/test-suite/bugs/closed/bug_2930.v new file mode 100644 index 0000000000..0994b6fb23 --- /dev/null +++ b/test-suite/bugs/closed/bug_2930.v @@ -0,0 +1,12 @@ +(* Checking that let-in's hiding evars are expanded when enforcing + "occur-check" *) + +Require Import List. + +Definition foo x y := +let xy := (x, y) in +let bar xys := + match xys with + | nil => xy :: nil + | xy' :: xys' => xy' :: xys' + end in bar (nil : list (nat * nat)). diff --git a/test-suite/bugs/closed/bug_2945.v b/test-suite/bugs/closed/bug_2945.v new file mode 100644 index 0000000000..59b57c07b7 --- /dev/null +++ b/test-suite/bugs/closed/bug_2945.v @@ -0,0 +1,5 @@ +Notation "f1 =1 f2 :> A" := (f1 = (f2 : A)) + (at level 70, f2 at next level, A at level 90) : fun_scope. + +Notation "e :? pf" := (eq_rect _ (fun X : _ => X) e _ pf) + (no associativity, at level 90). diff --git a/test-suite/bugs/closed/bug_2946.v b/test-suite/bugs/closed/bug_2946.v new file mode 100644 index 0000000000..c8b7255e7b --- /dev/null +++ b/test-suite/bugs/closed/bug_2946.v @@ -0,0 +1,8 @@ +Lemma toto (E : nat -> nat -> Prop) (x y : nat) + (Ex_ : forall z, E x z) (E_y : forall z, E z y) : True. + +(* OK *) +assert (pairE1 := let Exy := _ in (Ex_ y, E_y _) : Exy * Exy). + +(* FAIL *) +assert (pairE2 := let Exy := _ in (Ex_ _, E_y x) : Exy * Exy). diff --git a/test-suite/bugs/closed/bug_2951.v b/test-suite/bugs/closed/bug_2951.v new file mode 100644 index 0000000000..87d544416d --- /dev/null +++ b/test-suite/bugs/closed/bug_2951.v @@ -0,0 +1,2 @@ +Record C (A: Type) : Type := { f: A }. +Existing Class C. diff --git a/test-suite/bugs/closed/bug_2955.v b/test-suite/bugs/closed/bug_2955.v new file mode 100644 index 0000000000..8b024f0730 --- /dev/null +++ b/test-suite/bugs/closed/bug_2955.v @@ -0,0 +1,52 @@ +Require Import Coq.Arith.Arith. + +Module A. + + Fixpoint foo (n:nat) := + match n with + | 0 => 0 + | S n => bar n + end + + with bar (n:nat) := + match n with + | 0 => 0 + | S n => foo n + end. + + Lemma using_foo: + forall (n:nat), foo n = 0 /\ bar n = 0. + Proof. + induction n ; split ; auto ; + destruct IHn ; auto. + Qed. + +End A. + + +Module B. + + Module A := A. + Import A. + +End B. + +Module E. + + Module B := B. + Import B.A. + + (* Bug 1 *) + Lemma test_1: + forall (n:nat), foo n = 0. + Proof. + intros ; destruct n. + reflexivity. + specialize (A.using_foo (S n)) ; intros. + simpl in H. + simpl. + destruct H. + assumption. + Qed. + +End E. diff --git a/test-suite/bugs/closed/bug_2966.v b/test-suite/bugs/closed/bug_2966.v new file mode 100644 index 0000000000..92d5b9cdc9 --- /dev/null +++ b/test-suite/bugs/closed/bug_2966.v @@ -0,0 +1,79 @@ +(** Non-termination and state monad with extraction *) +Require Import List. + +Set Implicit Arguments. +Set Asymmetric Patterns. + +Module MemSig. + Definition t: Type := list Type. + + Definition Nth (sig: t) (n: nat) := + nth n sig unit. +End MemSig. + +(** A memory of type [Mem.t s] is the union of cells whose type is specified + by [s]. *) +Module Mem. + Inductive t: MemSig.t -> Type := + | Nil: t nil + | Cons: forall (T: Type), option T -> forall (sig: MemSig.t), t sig -> + t (T :: sig). +End Mem. + +Module Ref. + Inductive t (sig: MemSig.t) (T: Type): Type := + | Input: t sig T. + + Definition Read (sig: MemSig.t) (T: Type) (ref: t sig T) (s: Mem.t sig) + : option T := + match ref with + | Input => None + end. +End Ref. + +Module Monad. + Definition t (sig: MemSig.t) (A: Type) := + Mem.t sig -> option A * Mem.t sig. + + Definition Return (sig: MemSig.t) (A: Type) (x: A): t sig A := + fun s => + (Some x, s). + + Definition Bind (sig: MemSig.t) (A B: Type) (x: t sig A) (f: A -> t sig B) + : t sig B := + fun s => + match x s with + | (Some x', s') => f x' s' + | (None, s') => (None, s') + end. + + Definition Select (T: Type) (f g: unit -> T): T := + f tt. + + (** Read in a reference. *) + Definition Read (sig: MemSig.t) (T: Type) (ref: Ref.t sig T) + : t sig T := + fun s => + match Ref.Read ref s with + | None => (None, s) + | Some x => (Some x, s) + end. +End Monad. + +Import Monad. + +Definition pop (sig: MemSig.t) (T: Type) (trace: Ref.t sig (list T)) + : Monad.t sig T := + Bind (Read trace) (fun _ s => (None, s)). + +Definition sig: MemSig.t := (list nat: Type) :: nil. + +Definition trace: Ref.t sig (list nat). +Admitted. + +Definition Gre (sig: MemSig.t) (trace: _) + (f: bool -> bool): Monad.t sig nat := + Select (fun _ => pop trace) (fun _ => Return 0). + +Definition Arg := + Gre trace (fun _ => false). diff --git a/test-suite/bugs/closed/bug_2969.v b/test-suite/bugs/closed/bug_2969.v new file mode 100644 index 0000000000..7b1a261789 --- /dev/null +++ b/test-suite/bugs/closed/bug_2969.v @@ -0,0 +1,28 @@ +Require Import TestSuite.admit. +(* Check that Goal.V82.byps and Goal.V82.env are consistent *) + +(* This is a shorten variant of the initial bug which raised anomaly *) + +Goal forall x : nat, (forall z, (exists y:nat, z = y) -> True) -> True. +evar nat. +intros x H. +apply (H n). +unfold n. clear n. +eexists. +reflexivity. +Grab Existential Variables. +admit. +Admitted. + +(* Alternative variant which failed but without raising anomaly *) + +Goal forall x : nat, True. +evar nat. +intro x. +evar nat. +assert (H := eq_refl : n0 = n). +clearbody n n0. +exact I. +Grab Existential Variables. +admit. +Admitted. diff --git a/test-suite/bugs/closed/bug_2981.v b/test-suite/bugs/closed/bug_2981.v new file mode 100644 index 0000000000..44e53ca46c --- /dev/null +++ b/test-suite/bugs/closed/bug_2981.v @@ -0,0 +1,14 @@ +Check let TTT := Type in (fun (a b : @sigT TTT (fun A : TTT => A)) + (f : @projT1 TTT (fun A : TTT => A) a -> + @projT1 TTT (fun A : TTT => A) b) => + @eq_refl + (@projT1 TTT (fun A : TTT => A) a -> + @projT1 TTT (fun A : TTT => A) b) + (fun x : @projT1 TTT (fun A : TTT => A) a => f x)) : + forall (a b : @sigT TTT (fun A : TTT => A)) + (f : @projT1 TTT (fun A : TTT => A) a -> + @projT1 TTT (fun A : TTT => A) b), + @eq + (@projT1 TTT (fun A : TTT => A) a -> + @projT1 TTT (fun A : TTT => A) b) + (fun x : @projT1 TTT (fun A : TTT => A) a => f x) f. diff --git a/test-suite/bugs/closed/bug_2983.v b/test-suite/bugs/closed/bug_2983.v new file mode 100644 index 0000000000..ad76350949 --- /dev/null +++ b/test-suite/bugs/closed/bug_2983.v @@ -0,0 +1,8 @@ +Module Type ModA. +End ModA. +Module Type ModB(A : ModA). +End ModB. +Module Foo(A : ModA)(B : ModB A). +End Foo. + +Print Module Foo. diff --git a/test-suite/bugs/closed/bug_2990.v b/test-suite/bugs/closed/bug_2990.v new file mode 100644 index 0000000000..5f832626bc --- /dev/null +++ b/test-suite/bugs/closed/bug_2990.v @@ -0,0 +1,8 @@ +Goal True. +Proof. + evar (pfT : Type). + cut pfT. + subst pfT. + intro pf. + refine ((fun A : Set => pf A) unit). +Abort. diff --git a/test-suite/bugs/closed/bug_2994.v b/test-suite/bugs/closed/bug_2994.v new file mode 100644 index 0000000000..457b1893de --- /dev/null +++ b/test-suite/bugs/closed/bug_2994.v @@ -0,0 +1,2 @@ +(* Was an anomaly at some time *) +Fail Class foo : Prop := { bar :> Set }. diff --git a/test-suite/bugs/closed/bug_2995.v b/test-suite/bugs/closed/bug_2995.v new file mode 100644 index 0000000000..b6c5b6df44 --- /dev/null +++ b/test-suite/bugs/closed/bug_2995.v @@ -0,0 +1,9 @@ +Module Type Interface. + Parameter error: nat. +End Interface. + +Module Implementation <: Interface. + Definition t := bool. + Definition error: t := false. +Fail End Implementation. +(* A UserError here is expected, not an uncaught Not_found *) diff --git a/test-suite/bugs/closed/bug_2996.v b/test-suite/bugs/closed/bug_2996.v new file mode 100644 index 0000000000..d5409289c5 --- /dev/null +++ b/test-suite/bugs/closed/bug_2996.v @@ -0,0 +1,31 @@ +Require Import TestSuite.admit. +(* Test on definitions referring to section variables that are not any + longer in the current context *) + +Section x. + + Hypothesis h : forall(n : nat), n < S n. + + Definition f(n m : nat)(less : n < m) : nat := n + m. + + Lemma a : forall(n : nat), f n (S n) (h n) = 1 + 2 * n. + Proof. + (* XXX *) admit. + Qed. + + Lemma b : forall(n : nat), n < 3 + n. + Proof. + clear. + intros n. + Fail assert (H := a n). + Abort. + + Let T := True. + Definition p := I : T. + + Lemma paradox : False. + Proof. + clear. + set (T := False). + Fail pose proof p as H. + Abort. diff --git a/test-suite/bugs/closed/bug_3000.v b/test-suite/bugs/closed/bug_3000.v new file mode 100644 index 0000000000..27de34ed17 --- /dev/null +++ b/test-suite/bugs/closed/bug_3000.v @@ -0,0 +1,2 @@ +Inductive t (t':Type) : Type := A | B. +Definition d := match t with _ => 1 end. (* used to fail on list_chop *) diff --git a/test-suite/bugs/closed/bug_3001.v b/test-suite/bugs/closed/bug_3001.v new file mode 100644 index 0000000000..6e56555499 --- /dev/null +++ b/test-suite/bugs/closed/bug_3001.v @@ -0,0 +1,21 @@ +Definition my_fun (n:nat) := n. + +Section My_Sec. + Global Arguments my_fun x : rename. +End My_Sec. + +(* The following code suffices to trigger it, on my system: + + Definition my_fun (n:nat) := n. + + Section My_Sec. + Global Arguments my_fun x : rename. + End My_Sec. + +The `Global Arguments` declaration succeeds fine, but the `End My_Sec` fails, with `Anomaly: dirpath_prefix: empty dirpath. Please report.` + +If `Global` is removed, or if no arguments are renamed, then everything works as expected. + +If other declarations go between the `Global Arguments` and the `End My_Sec`, then the other declarations work normally, but the `End My_Sec` still fails. + +Previously reported at https://github.com/HoTT/coq/issues/24 . Occurs in both 8.4 and current trunk. *) diff --git a/test-suite/bugs/closed/bug_3003.v b/test-suite/bugs/closed/bug_3003.v new file mode 100644 index 0000000000..2f8bcdae7a --- /dev/null +++ b/test-suite/bugs/closed/bug_3003.v @@ -0,0 +1,12 @@ +(* This used to raise an anomaly in 8.4 and trunk up to 17 April 2013 *) + +Set Implicit Arguments. + +Inductive path (V : Type) (E : V -> V -> Type) (s : V) : V -> Type := + | NoEdges : path E s s + | AddEdge : forall d d' : V, path E s d -> E d d' -> path E s d'. +Inductive G_Vertex := G_v0 | G_v1. +Inductive G_Edge : G_Vertex -> G_Vertex -> Set := G_e : G_Edge G_v0 G_v1. +Goal forall x1 : G_Edge G_v1 G_v1, @AddEdge _ G_Edge G_v1 _ _ (NoEdges _ _) x1 = NoEdges _ _. +intro x1. +try destruct x1. (* now raises a typing error *) diff --git a/test-suite/bugs/closed/bug_3004.v b/test-suite/bugs/closed/bug_3004.v new file mode 100644 index 0000000000..896b1958b0 --- /dev/null +++ b/test-suite/bugs/closed/bug_3004.v @@ -0,0 +1,7 @@ +Set Implicit Arguments. +Unset Strict Implicit. +Parameter (M : nat -> Type). +Parameter (mp : forall (T1 T2 : Type) (f : T1 -> T2), list T1 -> list T2). + +Definition foo (s : list {n : nat & M n}) := + let exT := existT in mp (fun x => projT1 x) s. diff --git a/test-suite/bugs/closed/bug_3008.v b/test-suite/bugs/closed/bug_3008.v new file mode 100644 index 0000000000..1979eda820 --- /dev/null +++ b/test-suite/bugs/closed/bug_3008.v @@ -0,0 +1,29 @@ +Module Type Intf1. +Parameter T : Type. +Inductive a := A. +End Intf1. + +Module Impl1 <: Intf1. +Definition T := unit. +Inductive a := A. +End Impl1. + +Module Type Intf2 + (Impl1 : Intf1). +Parameter x : Impl1.A=Impl1.A -> Impl1.T. +End Intf2. + +Module Type Intf3 + (Impl1 : Intf1) + (Impl2 : Intf2(Impl1)). +End Intf3. + +Fail Module Toto + (Impl1' : Intf1) + (Impl2 : Intf2(Impl1')) + (Impl3 : Intf3(Impl1)(Impl2)). +(* A UserError is expected here, not an uncaught Not_found *) + +(* NB : the Inductive above and the A=A weren't in the initial test, + they are here only to force an access to the environment + (cf [Printer.qualid_of_global]) and check that this env is ok. *) diff --git a/test-suite/bugs/closed/bug_3010b.v b/test-suite/bugs/closed/bug_3010b.v new file mode 100644 index 0000000000..65fea42489 --- /dev/null +++ b/test-suite/bugs/closed/bug_3010b.v @@ -0,0 +1,5 @@ +Definition wtf (n : nat) : nat := + (match n with + 0 => (fun H : n = 0 => 0) + | S n' => (fun H : n = S n' => 0) + end) (eq_refl n). diff --git a/test-suite/bugs/closed/bug_3016.v b/test-suite/bugs/closed/bug_3016.v new file mode 100644 index 0000000000..bd4f1dd805 --- /dev/null +++ b/test-suite/bugs/closed/bug_3016.v @@ -0,0 +1,4 @@ +Section foo. + Variable C : Type. + Goal True. + change (eq (A := ?C) ?x ?y) with (eq). diff --git a/test-suite/bugs/closed/bug_3017.v b/test-suite/bugs/closed/bug_3017.v new file mode 100644 index 0000000000..63a06bd3d6 --- /dev/null +++ b/test-suite/bugs/closed/bug_3017.v @@ -0,0 +1,6 @@ +Class A := {}. + Class B {T} `(A) := { B_intro : forall t t' : T, t = t' }. + Lemma foo T (t t' : T) : t = t'. + erewrite @B_intro. + reflexivity. + Abort. diff --git a/test-suite/bugs/closed/bug_3022.v b/test-suite/bugs/closed/bug_3022.v new file mode 100644 index 0000000000..dcfe733974 --- /dev/null +++ b/test-suite/bugs/closed/bug_3022.v @@ -0,0 +1,8 @@ +Goal forall (O obj : Type) (f : O -> obj) (x : O) (e : x = x) + (T : obj -> obj -> Type) (m : forall x0 : obj, T x0 x0), + match eq_sym e in (_ = y) return (T (f y) (f x)) with + | eq_refl => m (f x) + end = m (f x). +intros. +try case e. +Abort. diff --git a/test-suite/bugs/closed/bug_3023.v b/test-suite/bugs/closed/bug_3023.v new file mode 100644 index 0000000000..70a1491e15 --- /dev/null +++ b/test-suite/bugs/closed/bug_3023.v @@ -0,0 +1,33 @@ +Set Implicit Arguments. +Generalizable All Variables. + +Record Category {obj : Type} := + { + Morphism : obj -> obj -> Type; + + Identity : forall x, Morphism x x; + Compose : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d'; + LeftIdentity : forall a b (f : Morphism a b), Compose (Identity b) f = f + }. + + +Section DiscreteAdjoints. + + Let C := {| + Morphism := (fun X Y : Type => X -> Y); + Identity := (fun X : Type => (fun x : X => x)); + Compose := (fun _ _ _ f g => (fun x => f (g x))); + LeftIdentity := (fun X Y p => @eq_refl _ p : (fun x : X => p x) = p) + |}. + Variable ObjectFunctor : C = C. + + Goal True. + Proof. + subst C. + revert ObjectFunctor. + intro ObjectFunctor. + simpl in ObjectFunctor. + revert ObjectFunctor. + Abort. + +End DiscreteAdjoints. diff --git a/test-suite/bugs/closed/bug_3036.v b/test-suite/bugs/closed/bug_3036.v new file mode 100644 index 0000000000..d60987a9e6 --- /dev/null +++ b/test-suite/bugs/closed/bug_3036.v @@ -0,0 +1,169 @@ +(* Checking use of retyping in w_unify0 in the presence of unification +problems of the form \x:Meta.Meta = \x:ind.match x with ... end *) + +Require Import List. +Require Import QArith. +Require Import Qcanon. + +Set Implicit Arguments. + +Inductive dynamic : Type := + | Dyn : forall T, T -> dynamic. + +Definition perm := Qc. + +Locate Qle_bool. + +Definition compatibleb (p1 p2 : perm) : bool := +let p1pos := Qle_bool 0 p1 in + let p2pos := Qle_bool 0 p2 in + negb ( + (p1pos && p2pos) + || ((p1pos || p2pos) && (negb (Qle_bool 0 ((p1 + p2)%Qc)))))%Qc. + +Definition compatible (p1 p2 : perm) := compatibleb p1 p2 = true. + +Definition perm_plus (p1 p2 : perm) : option perm := + if compatibleb p1 p2 then Some (p1 + p2) else None. + +Infix "+p" := perm_plus (at level 60, no associativity). + +Axiom axiom_ptr : Set. + +Definition ptr := axiom_ptr. + +Axiom axiom_ptr_eq_dec : forall (a b : ptr), {a = b} + {a <> b}. + +Definition ptr_eq_dec := axiom_ptr_eq_dec. + +Definition hval := (dynamic * perm)%type. + +Definition heap := ptr -> option hval. + +Bind Scope heap_scope with heap. +Delimit Scope heap_scope with heap. +Local Open Scope heap_scope. + +Definition read (h : heap) (p : ptr) : option hval := h p. + +Notation "a # b" := (read a b) (at level 55, no associativity) : heap_scope. + +Definition val (v:hval) := fst v. +Definition frac (v:hval) := snd v. + +Definition hval_plus (v1 v2 : hval) : option hval := + match (frac v1) +p (frac v2) with + | None => None + | Some v1v2 => Some (val v1, v1v2) + end. + +Definition hvalo_plus (v1 v2 : option hval) := + match v1 with + | None => v2 + | Some v1' => + match v2 with + | None => v1 + | Some v2' => (hval_plus v1' v2') + end + end. + +Notation "v1 +o v2" := (hvalo_plus v1 v2) (at level 60, no associativity) : heap_scope. + +Definition join (h1 h2 : heap) : heap := + (fun p => (h1 p) +o (h2 p)). + +Infix "*" := join (at level 40, left associativity) : heap_scope. + +Definition hprop := heap -> Prop. + +Bind Scope hprop_scope with hprop. +Delimit Scope hprop_scope with hprop. + +Definition hprop_cell (p : ptr) T (v : T) (pi:Qc): hprop := fun h => + h#p = Some (Dyn v, pi) /\ forall p', p' <> p -> h#p' = None. + +Notation "p ---> v" := (hprop_cell p v (0%Qc)) (at level 38, no associativity) : hprop_scope. + +Definition empty : heap := fun _ => None. + +Definition hprop_empty : hprop := eq empty. +Notation "'emp'" := hprop_empty : hprop_scope. + +Definition hprop_inj (P : Prop) : hprop := fun h => h = empty /\ P. +Notation "[ P ]" := (hprop_inj P) (at level 0, P at level 200) : hprop_scope. + +Definition hprop_imp (p1 p2 : hprop) : Prop := forall h, p1 h -> p2 h. +Infix "==>" := hprop_imp (right associativity, at level 55). + +Definition hprop_ex T (p : T -> hprop) : hprop := fun h => exists v, p v h. +Notation "'Exists' v :@ T , p" := (hprop_ex (fun v : T => p%hprop)) + (at level 90, T at next level) : hprop_scope. + +Local Open Scope hprop_scope. +Definition disjoint (h1 h2 : heap) : Prop := + forall p, + match h1#p with + | None => True + | Some v1 => match h2#p with + | None => True + | Some v2 => val v1 = val v2 + /\ compatible (frac v1) (frac v2) + end + end. + +Infix "<#>" := disjoint (at level 40, no associativity) : heap_scope. + +Definition split (h h1 h2 : heap) : Prop := h1 <#> h2 /\ h = h1 * h2. + +Notation "h ~> h1 * h2" := (split h h1 h2) (at level 40, h1 at next level, no associativity). + +Definition hprop_sep (p1 p2 : hprop) : hprop := fun h => + exists h1, exists h2, h ~> h1 * h2 + /\ p1 h1 + /\ p2 h2. +Infix "*" := hprop_sep (at level 40, left associativity) : hprop_scope. + +Section Stack. + Variable T : Set. + + Record node : Set := Node { + data : T; + next : option ptr + }. + + Fixpoint listRep (ls : list T) (hd : option ptr) {struct ls} : hprop := + match ls with + | nil => [hd = None] + | h :: t => + match hd with + | None => [False] + | Some hd' => Exists p :@ option ptr, hd' ---> Node h p * listRep t p + end + end%hprop. + + Definition stack := ptr. + + Definition rep q ls := (Exists po :@ option ptr, q ---> po * listRep ls po)%hprop. + + Definition isExistential T (x : T) := True. + + Theorem himp_ex_conc_trivial : forall T p p1 p2, + p ==> p1 * p2 + -> T + -> p ==> hprop_ex (fun _ : T => p1) * p2. + Admitted. + + Goal forall (s : ptr) (x : T) (nd : ptr) (v : unit) (x0 : list T) (v0 : option ptr) + (H0 : isExistential v0), + nd ---> {| data := x; next := v0 |} * (s ---> Some nd * listRep x0 v0) ==> + (Exists po :@ option ptr, + s ---> po * + match po with + | Some hd' => + Exists p :@ option ptr, + hd' ---> {| data := x; next := p |} * listRep x0 p + | None => [False] + end) * emp. + Proof. + intros. + try apply himp_ex_conc_trivial. diff --git a/test-suite/bugs/closed/bug_3037.v b/test-suite/bugs/closed/bug_3037.v new file mode 100644 index 0000000000..baa7eff549 --- /dev/null +++ b/test-suite/bugs/closed/bug_3037.v @@ -0,0 +1,11 @@ +(* Anomaly before 4a8950ec7a0d9f2b216e67e69b446c064590a8e9 *) + +Require Import Recdef. + +Function f_R (a: nat) {wf (fun x y: nat => False) a}:Prop:= + match a:nat with + | 0 => True + | (S y') => f_R y' + end. +(* Anomaly: File "plugins/funind/recdef.ml", line 916, characters 13-19: Assertion failed. +Please report. *) diff --git a/test-suite/bugs/closed/bug_3043.v b/test-suite/bugs/closed/bug_3043.v new file mode 100644 index 0000000000..654663b4fc --- /dev/null +++ b/test-suite/bugs/closed/bug_3043.v @@ -0,0 +1,4 @@ +Goal (fun A (P : A -> Prop) (X : sigT P) => proj1_sig (sig_of_sigT X)) = + (fun A (P : A -> Prop) (X : sigT P) => projT1 X). + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_3045.v b/test-suite/bugs/closed/bug_3045.v new file mode 100644 index 0000000000..b3c8bfecbc --- /dev/null +++ b/test-suite/bugs/closed/bug_3045.v @@ -0,0 +1,34 @@ + +Set Asymmetric Patterns. +Generalizable All Variables. +Set Implicit Arguments. +Set Universe Polymorphism. + +Record SpecializedCategory (obj : Type) := + { + Object :> _ := obj; + Morphism : obj -> obj -> Type; + + Compose : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' + }. + +Arguments Compose {obj} [C s d d'] _ _ : rename. + +Inductive ReifiedMorphism : forall objC (C : SpecializedCategory objC), C -> C -> Type := +| ReifiedComposedMorphism : forall objC C s d d', ReifiedMorphism C d d' -> ReifiedMorphism C s d -> @ReifiedMorphism objC C s d'. + +Fixpoint ReifiedMorphismDenote objC C s d (m : @ReifiedMorphism objC C s d) : Morphism C s d := + match m in @ReifiedMorphism objC C s d return Morphism C s d with + | ReifiedComposedMorphism _ _ _ _ _ m1 m2 => Compose (@ReifiedMorphismDenote _ _ _ _ m1) + (@ReifiedMorphismDenote _ _ _ _ m2) + end. + +Fixpoint ReifiedMorphismSimplifyWithProof objC C s d (m : @ReifiedMorphism objC C s d) +: { m' : ReifiedMorphism C s d | ReifiedMorphismDenote m = ReifiedMorphismDenote m' }. +refine match m with + | ReifiedComposedMorphism _ _ s0 d0 d0' m1 m2 => _ + end; clear m. +(* This fails with an error rather than an anomaly, but morally + it should work, if destruct were able to do the good generalization + in advance, before doing the "intros []". *) +Fail destruct (@ReifiedMorphismSimplifyWithProof T s1 d0 d0' m1) as [ [] ? ]. diff --git a/test-suite/bugs/closed/bug_3050.v b/test-suite/bugs/closed/bug_3050.v new file mode 100644 index 0000000000..4b18722431 --- /dev/null +++ b/test-suite/bugs/closed/bug_3050.v @@ -0,0 +1,7 @@ +Goal forall A B, A * B -> A. +Proof. +intros A B H. +match goal with + | [ H : _ * _ |- _ ] => exact (fst H) +end. +Qed. diff --git a/test-suite/bugs/closed/bug_3054.v b/test-suite/bugs/closed/bug_3054.v new file mode 100644 index 0000000000..936e58e197 --- /dev/null +++ b/test-suite/bugs/closed/bug_3054.v @@ -0,0 +1,10 @@ +Section S. + +Let V := Type. + +Goal ~ true = false. +Proof. +congruence. +Qed. + +End S. diff --git a/test-suite/bugs/closed/bug_3062.v b/test-suite/bugs/closed/bug_3062.v new file mode 100644 index 0000000000..a7b5fab03e --- /dev/null +++ b/test-suite/bugs/closed/bug_3062.v @@ -0,0 +1,5 @@ +Lemma foo : forall x y:nat, x < y -> False. +Proof. + intros x y H. + induction H as [ |?y ?y ?y]. +Abort. diff --git a/test-suite/bugs/closed/bug_3068.v b/test-suite/bugs/closed/bug_3068.v new file mode 100644 index 0000000000..04072ae305 --- /dev/null +++ b/test-suite/bugs/closed/bug_3068.v @@ -0,0 +1,64 @@ +Require Import TestSuite.admit. +Section Counted_list. + + Variable A : Type. + + Inductive counted_list : nat -> Type := + | counted_nil : counted_list 0 + | counted_cons : forall(n : nat), + A -> counted_list n -> counted_list (S n). + + + Fixpoint counted_def_nth{n : nat}(l : counted_list n) + (i : nat)(def : A) : A := + match i with + | 0 => match l with + | counted_nil => def + | counted_cons _ a _ => a + end + | S i => match l with + | counted_nil => def + | counted_cons _ _ tl => counted_def_nth tl i def + end + end. + + + Lemma counted_list_equal_nth_char : + forall(n : nat)(l1 l2 : counted_list n)(def : A), + (forall(i : nat), counted_def_nth l1 i def = counted_def_nth l2 i def) -> + l1 = l2. + Proof. + admit. + Qed. + +End Counted_list. + +Arguments counted_def_nth [A n]. + +Section Finite_nat_set. + + Variable set_size : nat. + + Definition fnat_subset : Type := counted_list bool set_size. + + Definition fnat_member(fs : fnat_subset)(n : nat) : Prop := + is_true (counted_def_nth fs n false). + + + Lemma fnat_subset_member_eq : forall(fs1 fs2 : fnat_subset), + fs1 = fs2 <-> + forall(n : nat), fnat_member fs1 n <-> fnat_member fs2 n. + + Proof. + intros fs1 fs2. + split. + intros H n. + subst fs1. + apply iff_refl. + intros H. + eapply (counted_list_equal_nth_char _ _ _ _ ?[def]). + intros i. + destruct (counted_def_nth fs1 i _ ) eqn:H0. + (* This was not part of the initial bug report; this is to check that + the existential variable kept its name *) + change (true = counted_def_nth fs2 i ?def). diff --git a/test-suite/bugs/closed/bug_3070.v b/test-suite/bugs/closed/bug_3070.v new file mode 100644 index 0000000000..7a8feca587 --- /dev/null +++ b/test-suite/bugs/closed/bug_3070.v @@ -0,0 +1,6 @@ +(* Testing subst wrt chains of dependencies *) + +Lemma foo (a1 a2 : Set) (b1 : a1 -> Prop) + (Ha : a1 = a2) (c : a1) (d : b1 c) : True. +Proof. + subst. diff --git a/test-suite/bugs/closed/bug_3071.v b/test-suite/bugs/closed/bug_3071.v new file mode 100644 index 0000000000..53c2ef7b71 --- /dev/null +++ b/test-suite/bugs/closed/bug_3071.v @@ -0,0 +1,5 @@ +Definition foo := True. + +Section foo. + Global Arguments foo / . +End foo. diff --git a/test-suite/bugs/closed/bug_3080.v b/test-suite/bugs/closed/bug_3080.v new file mode 100644 index 0000000000..36ab7ff599 --- /dev/null +++ b/test-suite/bugs/closed/bug_3080.v @@ -0,0 +1,18 @@ +(* -*- coq-prog-args: ("-nois") -*- *) +Delimit Scope type_scope with type. +Delimit Scope function_scope with function. + +Bind Scope type_scope with Sortclass. +Bind Scope function_scope with Funclass. + +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Notation "A -> B" := (forall (_ : A), B) : type_scope. + +Definition compose {A B C} (g : B -> C) (f : A -> B) := + fun x : A => g (f x). + +Notation " g ∘ f " := (compose g f) + (at level 40, left associativity) : function_scope. + +Fail Check (fun x => x) ∘ (fun x => x). (* this [Check] should fail, as [function_scope] is not opened *) +Check compose ((fun x => x) ∘ (fun x => x)) (fun x => x). (* this check should succeed, as [function_scope] should be automatically bound in the arugments to [compose] *) diff --git a/test-suite/bugs/closed/bug_3088.v b/test-suite/bugs/closed/bug_3088.v new file mode 100644 index 0000000000..3c362510e3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3088.v @@ -0,0 +1,12 @@ +Inductive R {A} : A -> A -> Type := c : forall x y, R x y. + +Goal forall A (x y : A) P (e : R x y) (f : forall x y, P x y (c x y)), + let g := match e in R x y return P x y e with c x y => f x y end in + True. +Proof. +intros A x y P e f g. +let t := eval red in g in +match t with + (match ?E as e in R x y return @?P x y e with c X Y => @?f X Y end) => idtac P f +end. +Abort. diff --git a/test-suite/bugs/closed/bug_3093.v b/test-suite/bugs/closed/bug_3093.v new file mode 100644 index 0000000000..f6b4a03f3b --- /dev/null +++ b/test-suite/bugs/closed/bug_3093.v @@ -0,0 +1,6 @@ +Require Import FunctionalExtensionality. + +Goal forall y, @f_equal = y. + intro. + apply functional_extensionality_dep. +Abort. diff --git a/test-suite/bugs/closed/bug_3100.v b/test-suite/bugs/closed/bug_3100.v new file mode 100644 index 0000000000..6f35a74dc1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3100.v @@ -0,0 +1,9 @@ +Fixpoint F (n : nat) (A : Type) : Type := + match n with + | 0 => True + | S n => forall (x : A), F n (x = x) + end. + +Goal forall A n, (forall (x : A) (e : x = x), F n (e = e)). +intros A n. +Fail change (forall x, F n (x = x)) with (F (S n)). diff --git a/test-suite/bugs/closed/bug_3125.v b/test-suite/bugs/closed/bug_3125.v new file mode 100644 index 0000000000..797146174d --- /dev/null +++ b/test-suite/bugs/closed/bug_3125.v @@ -0,0 +1,27 @@ +(* Not considering singleton template-polymorphic inductive types as + propositions for injection/inversion *) + +(* This is also #4560 and #6273 *) + +Inductive foo := foo_1. + +Goal forall (a b : foo), Some a = Some b -> a = b. +Proof. + intros a b H. + inversion H. + reflexivity. +Qed. + +(* Check that Prop is not concerned *) + +Inductive bar : Prop := bar_1. + +Goal + forall (a b : bar), + Some a = Some b -> + a = b. +Proof. + intros a b H. + inversion H. + Fail reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_3142.v b/test-suite/bugs/closed/bug_3142.v new file mode 100644 index 0000000000..988074e2f1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3142.v @@ -0,0 +1,9 @@ +(* Fixed together with #3262 in 48af6d1418282323b9fff0e789fed9478c064434 *) +(* April 4, 2014 (non-progress in candidates was not detected) *) + +Definition eqbool_dep (P : bool -> Prop) (h1 : P true) (b : bool) (h2 : P b) + : Prop := +(match b (* return P b -> Prop *) with + | true => fun (h : P true) => h1 = h + | false => fun (_ : P false) => False +end (* : P b -> Prop *)) h2. diff --git a/test-suite/bugs/closed/bug_3164.v b/test-suite/bugs/closed/bug_3164.v new file mode 100644 index 0000000000..3c9af8d0f3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3164.v @@ -0,0 +1,49 @@ +(* Before 31a69c4d0fd7b8325187e8da697a9c283594047d, [case] would stack overflow *) +Require Import Arith. + +Section Acc_generator. + Variable A : Type. + Variable R : A -> A -> Prop. + + (* *Lazily* add 2^n - 1 Acc_intro on top of wf. + Needed for fast reductions using Function and Program Fixpoint + and probably using Fix and Fix_F_2 + *) + Fixpoint Acc_intro_generator n (wf : well_founded R) := + match n with + | O => wf + | S n => fun x => Acc_intro x (fun y _ => Acc_intro_generator n (Acc_intro_generator n wf) y) + end. + + +End Acc_generator. + +Definition pred_F : (forall x : nat, + (forall y : nat, y < x -> (fun _ : nat => nat) y) -> + (fun _ : nat => nat) x). +Proof. + intros x. + simpl. + case x. + exact (fun _ => 0). + intros n h. + apply (h n). + constructor. +Defined. + +Definition my_pred := Fix lt_wf (fun _ => nat) pred_F. + + +Lemma my_pred_is_pred : forall x, match my_pred x with | 0 => True | S n => False end. +Proof. + intros x. + case x. +Abort. + +Definition my_pred_bad := Fix (Acc_intro_generator _ _ 100 lt_wf) (fun _ => nat) pred_F. + +Lemma my_pred_is_pred : forall x, match my_pred_bad x with | 0 => True | S n => False end. +Proof. + intros x. + Timeout 2 case x. +Admitted. diff --git a/test-suite/bugs/closed/bug_3188.v b/test-suite/bugs/closed/bug_3188.v new file mode 100644 index 0000000000..0117602670 --- /dev/null +++ b/test-suite/bugs/closed/bug_3188.v @@ -0,0 +1,22 @@ +(* File reduced by coq-bug-finder from 1656 lines to 221 lines to 26 lines to 7 lines. *) + +Module Long. + Require Import Coq.Classes.RelationClasses. + + Hint Extern 0 => apply reflexivity : typeclass_instances. + Hint Extern 1 => symmetry. + + Lemma foo : exists m' : Type, True. + intuition. (* Anomaly: Uncaught exception Not_found. Please report. *) + Abort. +End Long. + +Module Short. + Require Import Coq.Classes.RelationClasses. + + Hint Extern 0 => apply reflexivity : typeclass_instances. + + Lemma foo : exists m' : Type, True. + try symmetry. (* Anomaly: Uncaught exception Not_found. Please report. *) + Abort. +End Short. diff --git a/test-suite/bugs/closed/bug_3199.v b/test-suite/bugs/closed/bug_3199.v new file mode 100644 index 0000000000..08bf62493d --- /dev/null +++ b/test-suite/bugs/closed/bug_3199.v @@ -0,0 +1,18 @@ +Axiom P : nat -> Prop. +Axiom admit : forall n : nat, P n -> P n -> n = S n. +Axiom foo : forall n, P n. + +Create HintDb bar. +Hint Extern 3 => symmetry : bar. +Hint Resolve admit : bar. +Hint Immediate foo : bar. + +Lemma qux : forall n : nat, n = S n. +Proof. +intros n. +eauto with bar. +Defined. + +Goal True. +pose (e := eq_refl (qux 0)); unfold qux in e. +match type of e with context [eq_sym] => fail 1 | _ => idtac end. diff --git a/test-suite/bugs/closed/bug_3205.v b/test-suite/bugs/closed/bug_3205.v new file mode 100644 index 0000000000..5c44f07036 --- /dev/null +++ b/test-suite/bugs/closed/bug_3205.v @@ -0,0 +1,26 @@ +Fail Fixpoint F (u : unit) : Prop := + (fun p : {P : Prop & _} => match p with existT _ _ P => P end) + (existT (fun P => False -> P) (F tt) _). +(* Anomaly: A universe comparison can only happen between variables. +Please report. *) + + + +Definition g (x : Prop) := x. + +Definition h (y : Type) := y. + +Definition eq_hf : h = g :> (Prop -> Type) := + @eq_refl (Prop -> Type) g. + +Set Printing All. +Set Printing Universes. +Fail Definition eq_hf : h = g :> (Prop -> Type) := + eq_refl g. +(* Originally an anomaly, now says +Toplevel input, characters 48-57: +Error: +The term "@eq_refl (forall _ : Prop, Prop) g" has type + "@eq (forall _ : Prop, Prop) g g" while it is expected to have type + "@eq (forall _ : Prop, Type (* Top.16 *)) (fun y : Prop => h y) g" +(Universe inconsistency: Cannot enforce Prop = Top.16)). *) diff --git a/test-suite/bugs/closed/bug_3209.v b/test-suite/bugs/closed/bug_3209.v new file mode 100644 index 0000000000..b4075086d0 --- /dev/null +++ b/test-suite/bugs/closed/bug_3209.v @@ -0,0 +1,74 @@ +(* Avoiding some occur-check *) + +(* 1. Original example *) + +Inductive eqT {A} (x : A) : A -> Type := + reflT : eqT x x. +Definition Bi_inv (A B : Type) (f : (A -> B)) := + sigT (fun (g : B -> A) => + sigT (fun (h : B -> A) => + sigT (fun (α : forall b : B, eqT (f (g b)) b) => + forall a : A, eqT (h (f a)) a))). +Definition TEquiv (A B : Type) := sigT (fun (f : A -> B) => Bi_inv _ _ f). + +Axiom UA : forall (A B : Type), TEquiv (TEquiv A B) (eqT A B). +Definition idtoeqv {A B} (e : eqT A B) : TEquiv A B := + sigT_rect (fun _ => TEquiv A B) + (fun (f : TEquiv A B -> eqT A B) H => + sigT_rect _ (* (fun _ => TEquiv A B) *) + (fun g _ => g e) + H) + (UA A B). + +(* 2. Alternative example by Guillaume *) + +Inductive foo (A : Prop) : Prop := Foo : foo A. +Axiom bar : forall (A : Prop) (P : foo A -> Prop), (A -> P (Foo A)) -> Prop. + +(* This used to fail with a Not_found, we fail more graciously but a + heuristic could be implemented, e.g. in some smart occur-check + function, to find a solution of then form ?P := fun _ => ?P' *) + +Fail Check (fun e : ?[T] => bar ?[A] ?[P] (fun g : ?[A'] => g e)). + +(* This works and tells which solution we could have inferred *) + +Check (fun e : ?[T] => bar ?[A] (fun _ => ?[P]) (fun g : ?[A'] => g e)). + +(* For the record, here is the trace in the failing example: + +In (fun e : ?T => bar ?[A] ?[P] (fun g : ?A' => g e)), we have the existential variables + +e:?T |- ?A : Prop +e:?T |- ?P : foo ?A -> Prop +e:?T |- ?A' : Type + +with constraints + +?A' == ?A +?A' == ?T -> ?P (Foo ?A) + +To type (g e), unification first defines + +?A := forall x:?B, ?P'{e:=e,x:=x} +with ?T <= ?B +and ?P'@{e:=e,x:=e} <= ?P@{e:=e} (Foo (forall x:?B, ?P'{e:=e,x:=x})) + +Then, since ?P'@{e:=e,x:=e} may use "e" in two different ways, it is +not a pattern and we define a new + +e:?T x:?B|- ?P'' : foo (?B' -> ?P''') -> Prop + +for some ?B' and ?P''', together with + +?P'@{e,x} := ?P''{e:=e,x:=e} (Foo (?B -> ?P') +?P@{e} := ?P''{e:=e,x:=e} + +Moreover, ?B' and ?P''' have to satisfy + +?B'@{e:=e,x:=e} == ?B@{e:=e} +?P'''@{e:=e,x:=e} == ?P'@{e:=e,x:=x} + +and this leads to define ?P' which was the initial existential +variable to define. +*) diff --git a/test-suite/bugs/closed/bug_3210.v b/test-suite/bugs/closed/bug_3210.v new file mode 100644 index 0000000000..bb673f38c2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3210.v @@ -0,0 +1,22 @@ +(* Test support of let-in in arity of inductive types *) + +Inductive Foo : let X := Set in X := +| I : Foo. + +Definition foo (x : Foo) : bool := + match x with + I => true + end. + +Definition foo' (x : Foo) : x = x. +case x. +match goal with |- I = I => idtac end. (* check form of the goal *) +Undo 2. +elim x. +match goal with |- I = I => idtac end. (* check form of the goal *) +Undo 2. +induction x. +match goal with |- I = I => idtac end. (* check form of the goal *) +Undo 2. +destruct x. +match goal with |- I = I => idtac end. (* check form of the goal *) diff --git a/test-suite/bugs/closed/bug_3212.v b/test-suite/bugs/closed/bug_3212.v new file mode 100644 index 0000000000..53d8dfe326 --- /dev/null +++ b/test-suite/bugs/closed/bug_3212.v @@ -0,0 +1,10 @@ +Lemma H : Prop = Prop. +reflexivity. +Qed. + +Lemma foo : match H in (_ = X) return X with + | eq_refl => True +end. +Proof. +Fail destruct H. +Abort. diff --git a/test-suite/bugs/closed/bug_3217.v b/test-suite/bugs/closed/bug_3217.v new file mode 100644 index 0000000000..ec846bf95b --- /dev/null +++ b/test-suite/bugs/closed/bug_3217.v @@ -0,0 +1,36 @@ +(** [Set Implicit Arguments] causes Coq to run out of memory on [Qed] before c3feef4ed5dec126f1144dec91eee9c0f0522a94 *) +Set Implicit Arguments. + +Variable LEM: forall P : Prop, sumbool P (P -> False). + +Definition pmap := option (nat -> option nat). + +Definition pmplus (oha ohb: pmap) : pmap := + match oha, ohb with + | Some ha, Some hb => + if LEM (oha = ohb) then None else None + | _, _ => None + end. + +Definition pmemp: pmap := Some (fun _ => None). + +Lemma foo: + True -> + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + (pmplus pmemp + pmemp)))))))))))) + = + None -> True. +Proof. + auto. +Timeout 2 Qed. diff --git a/test-suite/bugs/closed/bug_3228.v b/test-suite/bugs/closed/bug_3228.v new file mode 100644 index 0000000000..5d1a0ff88b --- /dev/null +++ b/test-suite/bugs/closed/bug_3228.v @@ -0,0 +1,7 @@ +(* Check that variables in the context do not take precedence over + ltac variables *) + +Ltac bar x := exact x. +Goal False -> False. + intro x. + Fail bar doesnotexist. diff --git a/test-suite/bugs/closed/bug_3230.v b/test-suite/bugs/closed/bug_3230.v new file mode 100644 index 0000000000..265310b1a3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3230.v @@ -0,0 +1,14 @@ +Structure type : Type := Pack { ob : Type }. +Polymorphic Record category := { foo : Type }. +Definition FuncComp := Pack category. +Axiom C : category. + +Check (C : ob FuncComp). (* OK *) + +Canonical Structure FuncComp. + +Check (C : ob FuncComp). +(* Toplevel input, characters 15-39: +Error: +The term "C" has type "category" while it is expected to have type + "ob FuncComp". *) diff --git a/test-suite/bugs/closed/bug_3242.v b/test-suite/bugs/closed/bug_3242.v new file mode 100644 index 0000000000..145375c1ad --- /dev/null +++ b/test-suite/bugs/closed/bug_3242.v @@ -0,0 +1 @@ +Inductive Foo (x := Type) := C : Foo -> Foo. diff --git a/test-suite/bugs/closed/bug_3249.v b/test-suite/bugs/closed/bug_3249.v new file mode 100644 index 0000000000..71d457b002 --- /dev/null +++ b/test-suite/bugs/closed/bug_3249.v @@ -0,0 +1,11 @@ +Set Implicit Arguments. + +Ltac ret_and_left T := + let t := type of T in + lazymatch eval hnf in t with + | ?a /\ ?b => constr:(proj1 T) + | forall x : ?T', @?f x => + constr:(fun x : T' => ltac:(let fx := constr:(T x) in + let t := ret_and_left fx in + exact t)) + end. diff --git a/test-suite/bugs/closed/bug_3251.v b/test-suite/bugs/closed/bug_3251.v new file mode 100644 index 0000000000..d4ce050c57 --- /dev/null +++ b/test-suite/bugs/closed/bug_3251.v @@ -0,0 +1,14 @@ +Goal True. +idtac. +Ltac foo := idtac. +(* print out happens twice: +foo is defined +foo is defined + +... that's fishy. But E. Tassi tells me that it's expected since "Ltac" generates a side +effect that escapes the proof. In the STM model this means the command is executed twice, +once in the proof branch, and another time in the main branch *) +Undo. +Ltac foo := idtac. +(* Before 5b39c3535f7b3383d89d7b844537244a4e7c0eca, this would print out: *) +(* Anomaly: Backtrack.backto to a state with no vcs_backup. Please report. *) diff --git a/test-suite/bugs/closed/bug_3257.v b/test-suite/bugs/closed/bug_3257.v new file mode 100644 index 0000000000..d8aa6a0479 --- /dev/null +++ b/test-suite/bugs/closed/bug_3257.v @@ -0,0 +1,5 @@ +Require Import Setoid Morphisms Basics. +Lemma foo A B (P : B -> Prop) : + pointwise_relation _ impl (fun z => A -> P z) P. +Proof. + Fail reflexivity. diff --git a/test-suite/bugs/closed/bug_3258.v b/test-suite/bugs/closed/bug_3258.v new file mode 100644 index 0000000000..b263c6baf4 --- /dev/null +++ b/test-suite/bugs/closed/bug_3258.v @@ -0,0 +1,36 @@ +Require Import TestSuite.admit. +Require Import Coq.Classes.Morphisms Coq.Classes.RelationClasses Coq.Program.Program Coq.Setoids.Setoid. + +Global Set Implicit Arguments. + +Hint Extern 0 => apply reflexivity : typeclass_instances. + +Inductive Comp : Type -> Type := +| Pick : forall A, (A -> Prop) -> Comp A. + +Axiom computes_to : forall A, Comp A -> A -> Prop. + +Axiom refine : forall {A} (old : Comp A) (new : Comp A), Prop. + +Global Instance refine_PreOrder A : PreOrder (@refine A). +Admitted. +Add Parametric Morphism A +: (@Pick A) + with signature + (pointwise_relation _ (flip impl)) + ==> (@refine A) + as refine_flip_impl_Pick. + admit. +Defined. +Definition remove_forall_eq' A x B (P : A -> B -> Prop) : pointwise_relation _ impl (P x) (fun z => forall y : A, y = x -> P y z). + admit. +Defined. +Goal forall A B (x : A) (P : _ -> _ -> Prop), + refine (Pick (fun n : B => forall y, y = x -> P y n)) + (Pick (fun n : B => P x n)). +Proof. + intros. + setoid_rewrite (@remove_forall_eq' _ _ _ _). + Undo. + (* This failed with NotConvertible at some time *) + setoid_rewrite (@remove_forall_eq' _ _ _). diff --git a/test-suite/bugs/closed/bug_3259.v b/test-suite/bugs/closed/bug_3259.v new file mode 100644 index 0000000000..aa91fc3de7 --- /dev/null +++ b/test-suite/bugs/closed/bug_3259.v @@ -0,0 +1,22 @@ +Require Import TestSuite.admit. +Goal forall m n, n+n = m+m -> m+m = m+m. +Proof. +intros. +set (k := n+n) in *. +cut (n=m). +intro. +subst n. +admit. +admit. +Qed. + +Goal forall m n, n+n = m+m -> n+n = m+m. +Proof. +intros. +set (k := n+n). +cut (n=m). +intro. +subst n. +admit. +admit. +Qed. diff --git a/test-suite/bugs/closed/bug_3260.v b/test-suite/bugs/closed/bug_3260.v new file mode 100644 index 0000000000..9f0231d91b --- /dev/null +++ b/test-suite/bugs/closed/bug_3260.v @@ -0,0 +1,7 @@ +Require Import Setoid. +Goal forall m n, n = m -> n+n = m+m. +intros. +replace n with m at 2. +lazymatch goal with +|- n + m = m + m => idtac +end. diff --git a/test-suite/bugs/closed/bug_3262.v b/test-suite/bugs/closed/bug_3262.v new file mode 100644 index 0000000000..70bfde2990 --- /dev/null +++ b/test-suite/bugs/closed/bug_3262.v @@ -0,0 +1,78 @@ +(* Not having a [return] clause causes the [refine] at the bottom to stack overflow before f65fa9de8a4c9c12d933188a755b51508bd51921 *) + +Require Import Coq.Lists.List. +Require Import Relations RelationClasses. + +Set Implicit Arguments. +Set Strict Implicit. +Set Asymmetric Patterns. + +Section hlist. + Context {iT : Type}. + Variable F : iT -> Type. + + Inductive hlist : list iT -> Type := + | Hnil : hlist nil + | Hcons : forall l ls, F l -> hlist ls -> hlist (l :: ls). + + Definition hlist_hd {a b} (hl : hlist (a :: b)) : F a := + match hl in hlist x return match x with + | nil => unit + | l :: _ => F l + end with + | Hnil => tt + | Hcons _ _ x _ => x + end. + + Definition hlist_tl {a b} (hl : hlist (a :: b)) : hlist b := + match hl in hlist x return match x with + | nil => unit + | _ :: ls => hlist ls + end with + | Hnil => tt + | Hcons _ _ _ x => x + end. + + Lemma hlist_eta : forall ls (h : hlist ls), + h = match ls as ls return hlist ls -> hlist ls with + | nil => fun _ => Hnil + | a :: b => fun h => Hcons (hlist_hd h) (hlist_tl h) + end h. + Proof. + intros. destruct h; auto. + Qed. + + Variable eqv : forall x, relation (F x). + + Inductive equiv_hlist : forall ls, hlist ls -> hlist ls -> Prop := + | hlist_eqv_nil : equiv_hlist Hnil Hnil + | hlist_eqv_cons : forall l ls x y h1 h2, eqv x y -> equiv_hlist h1 h2 -> + @equiv_hlist (l :: ls) (Hcons x h1) (Hcons y h2). + + Global Instance Reflexive_equiv_hlist (R : forall t, Reflexive (@eqv t)) ls + : Reflexive (@equiv_hlist ls). + Proof. + red. induction x; constructor; auto. reflexivity. + Qed. + + Global Instance Transitive_equiv_hlist (R : forall t, Transitive (@eqv t)) ls + : Transitive (@equiv_hlist ls). + Proof. + red. induction 1. + { intro; assumption. } + { rewrite (hlist_eta z). + Timeout 2 Fail refine + (fun H => + match H in @equiv_hlist ls X Y + return + (* Uncommenting the following gives an immediate error in 8.4pl3; commented out results in a stack overflow *) + match ls (*as ls return hlist ls -> hlist ls -> Type*) with + | nil => fun _ _ : hlist nil => True + | l :: ls => fun (X Y : hlist (l :: ls)) => + equiv_hlist (Hcons x h1) Y + end X Y + with + | hlist_eqv_nil => I + | hlist_eqv_cons l ls x y h1 h2 pf pf' => + _ + end). diff --git a/test-suite/bugs/closed/bug_3264.v b/test-suite/bugs/closed/bug_3264.v new file mode 100644 index 0000000000..4eb218906f --- /dev/null +++ b/test-suite/bugs/closed/bug_3264.v @@ -0,0 +1,45 @@ +Module File1. + Module Export DirA. + Module A. + Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + + Arguments idpath {A a} , [A] a. + + Notation "x = y :> A" := (@paths A x y) : type_scope. + Notation "x = y" := (x = y :>_) : type_scope. + End A. + End DirA. +End File1. + +Module File2. + Module Export DirA. + Module B. + Import File1. + Export A. + Lemma foo : forall x y : Type, x = y -> y = x. + Proof. + intros x y H. + rewrite <- H. + constructor. + Qed. + End B. + End DirA. +End File2. + +Module File3. + Module Export DirA. + Module C. + Import File1. + Export A. + Lemma bar : forall x y : Type, x = y -> y = x. + Proof. + intros x y H. + rewrite <- H. + constructor. + Defined. + Definition bar' + := Eval cbv beta iota zeta delta [bar internal_paths_rew] in bar. + End C. + End DirA. +End File3. diff --git a/test-suite/bugs/closed/bug_3265.v b/test-suite/bugs/closed/bug_3265.v new file mode 100644 index 0000000000..269c7b741e --- /dev/null +++ b/test-suite/bugs/closed/bug_3265.v @@ -0,0 +1,6 @@ +Require Import Setoid. +Hint Extern 0 => apply reflexivity : typeclass_instances. +Goal forall (B : Type) (P : B -> Prop), exists y : B, P y. + intros. + try reflexivity. (* Anomaly: Uncaught exception Not_found. Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3266.v b/test-suite/bugs/closed/bug_3266.v new file mode 100644 index 0000000000..fd4cbff85c --- /dev/null +++ b/test-suite/bugs/closed/bug_3266.v @@ -0,0 +1,3 @@ +Class A := a : nat. +Lemma p : True. +Proof. cut A; [tauto | exact 1]. Qed. diff --git a/test-suite/bugs/closed/bug_3267.v b/test-suite/bugs/closed/bug_3267.v new file mode 100644 index 0000000000..8175d66ac7 --- /dev/null +++ b/test-suite/bugs/closed/bug_3267.v @@ -0,0 +1,47 @@ +Module a. + Local Hint Extern 0 => progress subst. + Goal forall T (x y : T) (P Q : _ -> Prop), x = y -> (P x -> Q x) -> P y -> Q y. + Proof. + intros. + (* this should not fail *) + progress eauto. + Defined. +End a. + +Module b. + Local Hint Extern 0 => progress subst. + Goal forall T (x y : T) (P Q : _ -> Prop), y = x -> (P x -> Q x) -> P y -> Q y. + Proof. + intros. + eauto. + Defined. +End b. + +Module c. + Local Hint Extern 0 => progress subst; eauto. + Goal forall T (x y : T) (P Q : _ -> Prop), x = y -> (P x -> Q x) -> P y -> Q y. + Proof. + intros. + eauto. + Defined. +End c. + +Module d. + Local Hint Extern 0 => progress subst; repeat match goal with H : _ |- _ => revert H end. + Goal forall T (x y : T) (P Q : _ -> Prop), x = y -> (P x -> Q x) -> P y -> Q y. + Proof. + intros. + debug eauto. + Defined. +End d. + +(* An other variant which was still failing in 8.5 beta2 *) + +Parameter A B : Prop. +Axiom a:B. + +Hint Extern 1 => match goal with H:_ -> id _ |- _ => try (unfold id in H) end. +Goal (B -> id A) -> A. +intros. +eauto using a. +Abort. diff --git a/test-suite/bugs/closed/bug_3281.v b/test-suite/bugs/closed/bug_3281.v new file mode 100644 index 0000000000..d340f0ca48 --- /dev/null +++ b/test-suite/bugs/closed/bug_3281.v @@ -0,0 +1,5 @@ +Fail Lemma foo : @eq _ nat Type. +Fail Lemma foo : @eq Set nat Type. + +Lemma foo : @eq Type nat Type. Admitted. +Lemma foo' : @eq _ Type nat. Admitted. diff --git a/test-suite/bugs/closed/bug_3282.v b/test-suite/bugs/closed/bug_3282.v new file mode 100644 index 0000000000..ce7cab1cba --- /dev/null +++ b/test-suite/bugs/closed/bug_3282.v @@ -0,0 +1,7 @@ +(* Check let-ins in fix and Fixpoint *) + +Definition foo := fix f (m : nat) (o := true) (n : nat) {struct n} := + match n with 0 => 0 | S n' => f 0 n' end. + +Fixpoint f (m : nat) (o := true) (n : nat) {struct n} := + match n with 0 => 0 | S n' => f 0 n' end. diff --git a/test-suite/bugs/closed/bug_3284.v b/test-suite/bugs/closed/bug_3284.v new file mode 100644 index 0000000000..34cd09c6f4 --- /dev/null +++ b/test-suite/bugs/closed/bug_3284.v @@ -0,0 +1,23 @@ +(* Several bugs: +- wrong env in pose_all_metas_as_evars leading to out of scope instance of evar +- check that metas posed as evars in pose_all_metas_as_evars were + resolved was not done +*) + +Axiom functional_extensionality_dep : + forall {A : Type} {B : A -> Type} (f g : forall x : A, B x), + (forall x : A, f x = g x) -> f = g. + +Goal forall A B C (f g : forall (x : A) (y : B x), C x y), forall x:A, (forall x y, f x y = g x y) -> True. +Proof. + intros A B C f g x H. + Fail apply @functional_extensionality_dep in H. + Fail apply functional_extensionality_dep in H. + eapply functional_extensionality_dep in H. +Abort. + +Goal forall A B C (f g : forall (x : A) (y : B x), C x y), forall x:A, (forall x y, f x y = g x y) -> True. +Proof. + intros A B C f g x H. + specialize (H x). + apply functional_extensionality_dep in H. diff --git a/test-suite/bugs/closed/bug_3285.v b/test-suite/bugs/closed/bug_3285.v new file mode 100644 index 0000000000..68e6b7386f --- /dev/null +++ b/test-suite/bugs/closed/bug_3285.v @@ -0,0 +1,7 @@ +Goal True. +Proof. +match goal with + | _ => let x := constr:(ltac:(fail)) in idtac + | _ => idtac +end. +Abort. diff --git a/test-suite/bugs/closed/bug_3286.v b/test-suite/bugs/closed/bug_3286.v new file mode 100644 index 0000000000..701480fc83 --- /dev/null +++ b/test-suite/bugs/closed/bug_3286.v @@ -0,0 +1,41 @@ +Require Import FunctionalExtensionality. + +Ltac make_apply_under_binders_in lem H := + let tac := make_apply_under_binders_in in + match type of H with + | forall x : ?T, @?P x + => let ret := constr:(fun x' : T => + let Hx := H x' in + ltac:(let ret' := tac lem Hx in + exact ret')) in + match eval cbv zeta in ret with + | fun x => Some (@?P x) => let P' := (eval cbv zeta in P) in + constr:(Some P') + end + | _ => let ret := constr:(ltac:(match goal with + | _ => (let H' := fresh in + pose H as H'; + apply lem in H'; + exact (Some H')) + | _ => exact (@None nat) + end + )) in + let ret' := (eval cbv beta zeta in ret) in + constr:(ret') + | _ => constr:(@None nat) + end. + +Ltac apply_under_binders_in lem H := + let H' := make_apply_under_binders_in lem H in + let H'0 := match H' with Some ?H'0 => constr:(H'0) end in + let H'' := fresh in + pose proof H'0 as H''; + clear H; + rename H'' into H. + +Goal forall A B C (f g : forall (x : A) (y : B x), C x y), (forall x y, f x y = g x y) -> True. +Proof. + intros A B C f g H. + let lem := constr:(@functional_extensionality_dep) in + apply_under_binders_in lem H. +(* Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/bug_3287.v b/test-suite/bugs/closed/bug_3287.v new file mode 100644 index 0000000000..4b3e7ff054 --- /dev/null +++ b/test-suite/bugs/closed/bug_3287.v @@ -0,0 +1,19 @@ +Require Coq.extraction.Extraction. + +Module Foo. +(* Definition foo := (I,I). *) +Definition bar := true. +End Foo. + +Recursive Extraction Foo.bar. +Extraction TestCompile Foo.bar. + +Module Foo'. +Definition foo := (I,I). +Definition bar := true. +End Foo'. + +Recursive Extraction Foo'.bar. +Extraction TestCompile Foo'.bar. + +Extraction Foo'.bar. diff --git a/test-suite/bugs/closed/bug_3289.v b/test-suite/bugs/closed/bug_3289.v new file mode 100644 index 0000000000..4542b015d0 --- /dev/null +++ b/test-suite/bugs/closed/bug_3289.v @@ -0,0 +1,27 @@ +(* File reduced by coq-bug-finder from original input, then from 1829 lines to 37 lines, then from 47 lines to 18 lines *) + +Class Contr_internal (A : Type) := + BuildContr { center : A ; + contr : (forall y : A, True) }. +Class Contr A := Contr_is_contr : Contr_internal A. +Inductive Unit : Set := tt. +Instance contr_unit : Contr Unit | 0 := + let x := {| + center := tt; + contr := fun t : Unit => I + |} in x. (* success *) + +Instance contr_internal_unit' : Contr_internal Unit | 0 := + {| + center := tt; + contr := fun t : Unit => I + |}. + +Instance contr_unit' : Contr Unit | 0 := + {| + center := tt; + contr := fun t : Unit => I + |}. +(* Error: Mismatched contexts while declaring instance: + Expected: (Contr_is_contr : Contr_internal _UNBOUND_REL_1) + Found: tt (fun t : Unit => I) *) diff --git a/test-suite/bugs/closed/bug_3291.v b/test-suite/bugs/closed/bug_3291.v new file mode 100644 index 0000000000..4ea748c0fb --- /dev/null +++ b/test-suite/bugs/closed/bug_3291.v @@ -0,0 +1,9 @@ +Require Import Setoid. + +Definition segv : forall x, (x = 0%nat) -> (forall (y : nat), (y < x)%nat -> nat) = forall (y : nat), (y < 0)%nat -> nat. +intros x eq. +assert (H : forall y, (y < x)%nat = (y < 0)%nat). +rewrite -> eq. auto. +Set Typeclasses Debug. +Fail setoid_rewrite <- H. (* The command has indeed failed with message: +=> Stack overflow. *) diff --git a/test-suite/bugs/closed/bug_3294.v b/test-suite/bugs/closed/bug_3294.v new file mode 100644 index 0000000000..ed1a0c29ae --- /dev/null +++ b/test-suite/bugs/closed/bug_3294.v @@ -0,0 +1,6 @@ +Check (match true return + match eq_refl Type return Type with eq_refl => bool end + with _ => true end). +Check (match true return + match eq_refl Type with eq_refl => bool end + with _ => true end). diff --git a/test-suite/bugs/closed/bug_3297.v b/test-suite/bugs/closed/bug_3297.v new file mode 100644 index 0000000000..1cacb97ff3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3297.v @@ -0,0 +1,12 @@ +Goal forall (n : nat) (H := eq_refl : n = n) (H' : n = 0), H = eq_refl. + intros. + subst. (* Toplevel input, characters 15-20: +Error: Abstracting over the term "n" leads to a term +"λ n : nat, H = eq_refl" which is ill-typed. *) + Undo. + revert H. + subst. (* success *) + Undo. + intro. + clearbody H. + subst. (* success *) diff --git a/test-suite/bugs/closed/bug_3298.v b/test-suite/bugs/closed/bug_3298.v new file mode 100644 index 0000000000..f07ee1e6cf --- /dev/null +++ b/test-suite/bugs/closed/bug_3298.v @@ -0,0 +1,22 @@ +Require Import TestSuite.admit. +Module JGross. + Hint Extern 1 => match goal with |- match ?E with end => case E end. + + Goal forall H : False, match H return Set with end. + Proof. + intros. + solve [ eauto ]. + Qed. +End JGross. + +Section BenDelaware. + Hint Extern 0 => admit. + Goal forall (H : False), id (match H return Set with end). + Proof. + eauto. + Qed. + Goal forall (H : False), match H return Set with end. + Proof. + solve [ eauto ] . + Qed. +End BenDelaware. diff --git a/test-suite/bugs/closed/bug_3300.v b/test-suite/bugs/closed/bug_3300.v new file mode 100644 index 0000000000..a28144b9ca --- /dev/null +++ b/test-suite/bugs/closed/bug_3300.v @@ -0,0 +1,7 @@ +Set Primitive Projections. +Record Box (T : Type) : Prop := wrap {prop : T}. + +Definition down (x : Type) : Prop := Box x. +Definition up (x : Prop) : Type := x. + +Fail Definition back A : up (down A) -> A := @prop A. diff --git a/test-suite/bugs/closed/bug_3305.v b/test-suite/bugs/closed/bug_3305.v new file mode 100644 index 0000000000..f3f2195228 --- /dev/null +++ b/test-suite/bugs/closed/bug_3305.v @@ -0,0 +1,13 @@ +Require Export Coq.Classes.RelationClasses. + +Section defs. + Variable A : Type. + Variable lt : A -> A -> Prop. + Context {ltso : StrictOrder lt}. + + Goal forall (a : A), lt a a -> False. + Proof. + intros a H. + contradict (irreflexivity H). + Qed. +End defs. diff --git a/test-suite/bugs/closed/bug_3306.v b/test-suite/bugs/closed/bug_3306.v new file mode 100644 index 0000000000..ae78a8e714 --- /dev/null +++ b/test-suite/bugs/closed/bug_3306.v @@ -0,0 +1,12 @@ + +Inductive Foo(A : Type) : Prop := + foo: A -> Foo A. + +Arguments foo [A] _. + +Scheme Foo_elim := Induction for Foo Sort Prop. + +Goal forall (fn : Foo nat), { x: nat | foo x = fn }. +intro fn. +Fail induction fn as [n] using Foo_elim. (* should fail in a non-Prop context *) +Admitted. diff --git a/test-suite/bugs/closed/bug_3310.v b/test-suite/bugs/closed/bug_3310.v new file mode 100644 index 0000000000..d6c31c6b41 --- /dev/null +++ b/test-suite/bugs/closed/bug_3310.v @@ -0,0 +1,11 @@ +Set Primitive Projections. +Set Implicit Arguments. + +CoInductive stream A := cons { hd : A; tl : stream A }. + +CoFixpoint id {A} (s : stream A) := cons (hd s) (id (tl s)). + +Lemma id_spec : forall A (s : stream A), id s = s. +Proof. +intros A s. +Fail change (id s) with (cons (hd (id s)) (tl (id s))). diff --git a/test-suite/bugs/closed/bug_3314.v b/test-suite/bugs/closed/bug_3314.v new file mode 100644 index 0000000000..a5782298c3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3314.v @@ -0,0 +1,148 @@ +Require Import TestSuite.admit. +Set Universe Polymorphism. +Definition Lift +: ltac:(let U1 := constr:(Type) in + let U0 := constr:(Type : U1) in + exact (U0 -> U1)) + := fun T => T. + +Fail Check nat:Prop. (* The command has indeed failed with message: +=> Error: +The term "nat" has type "Set" while it is expected to have type "Prop". *) +Set Printing All. +Set Printing Universes. +Fail Check Lift nat : Prop. (* Lift (* Top.8 Top.9 Top.10 *) nat:Prop + : Prop +(* Top.10 + Top.9 + Top.8 |= Top.10 < Top.9 + Top.9 < Top.8 + Top.9 <= Prop + *) + *) +Fail Eval compute in Lift nat : Prop. +(* = nat + : Prop *) + +Section Hurkens. + + Monomorphic Definition Type2 := Type. + Monomorphic Definition Type1 := Type : Type2. + + (** Assumption of a retract from Type into Prop *) + + Variable down : Type1 -> Prop. + Variable up : Prop -> Type1. + + Hypothesis back : forall A, up (down A) -> A. + + Hypothesis forth : forall A, A -> up (down A). + + Hypothesis backforth : forall (A:Type) (P:A->Type) (a:A), + P (back A (forth A a)) -> P a. + + Hypothesis backforth_r : forall (A:Type) (P:A->Type) (a:A), + P a -> P (back A (forth A a)). + + (** Proof *) + + Definition V : Type1 := forall A:Prop, ((up A -> Prop) -> up A -> Prop) -> up A -> Prop. + Definition U : Type1 := V -> Prop. + + Definition sb (z:V) : V := fun A r a => r (z A r) a. + Definition le (i:U -> Prop) (x:U) : Prop := x (fun A r a => i (fun v => sb v A r a)). + Definition le' (i:up (down U) -> Prop) (x:up (down U)) : Prop := le (fun a:U => i (forth _ a)) (back _ x). + Definition induct (i:U -> Prop) : Type1 := forall x:U, up (le i x) -> up (i x). + Definition WF : U := fun z => down (induct (fun a => z (down U) le' (forth _ a))). + Definition I (x:U) : Prop := + (forall i:U -> Prop, up (le i x) -> up (i (fun v => sb v (down U) le' (forth _ x)))) -> False. + + Lemma Omega : forall i:U -> Prop, induct i -> up (i WF). + Proof. + intros i y. + apply y. + unfold le, WF, induct. + apply forth. + intros x H0. + apply y. + unfold sb, le', le. + compute. + apply backforth_r. + exact H0. + Qed. + + Lemma lemma1 : induct (fun u => down (I u)). + Proof. + unfold induct. + intros x p. + apply forth. + intro q. + generalize (q (fun u => down (I u)) p). + intro r. + apply back in r. + apply r. + intros i j. + unfold le, sb, le', le in j |-. + apply backforth in j. + specialize q with (i := fun y => i (fun v:V => sb v (down U) le' (forth _ y))). + apply q. + exact j. + Qed. + + Lemma lemma2 : (forall i:U -> Prop, induct i -> up (i WF)) -> False. + Proof. + intro x. + generalize (x (fun u => down (I u)) lemma1). + intro r; apply back in r. + apply r. + intros i H0. + apply (x (fun y => i (fun v => sb v (down U) le' (forth _ y)))). + unfold le, WF in H0. + apply back in H0. + exact H0. + Qed. + + Theorem paradox : False. + Proof. + exact (lemma2 Omega). + Qed. + +End Hurkens. + +Definition informative (x : bool) := + match x with + | true => Type + | false => Prop + end. + +Definition depsort (T : Type) (x : bool) : informative x := + match x with + | true => T + | false => True + end. + +(** This definition should fail *) +Fail Definition Box (T : Type1) : Prop := Lift T. + +Fail Definition prop {T : Type1} (t : Box T) : T := t. +Fail Definition wrap {T : Type1} (t : T) : Box T := t. + +Fail Definition down (x : Type1) : Prop := Box x. +Definition up (x : Prop) : Type1 := x. + +Fail Definition back A : up (down A) -> A := @prop A. + +Fail Definition forth (A : Type1) : A -> up (down A) := @wrap A. + +Fail Definition backforth (A:Type1) (P:A->Type) (a:A) : + P (back A (forth A a)) -> P a := fun H => H. + +Fail Definition backforth_r (A:Type1) (P:A->Type) (a:A) : + P a -> P (back A (forth A a)) := fun H => H. + +Theorem pandora : False. + Fail apply (paradox down up back forth backforth backforth_r). + admit. +Qed. + +Print Assumptions pandora. diff --git a/test-suite/bugs/closed/bug_3315.v b/test-suite/bugs/closed/bug_3315.v new file mode 100644 index 0000000000..b69097f921 --- /dev/null +++ b/test-suite/bugs/closed/bug_3315.v @@ -0,0 +1,37 @@ +Set Universe Polymorphism. +Set Primitive Projections. +Set Implicit Arguments. +Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. +Arguments existT {A} _ _ _. +Definition unpack_sigma' {A} {P : A -> Type} (Q : sigT P -> Type) (u : sigT P) : + Q (existT _ (projT1 u) (projT2 u)) -> Q u + := + fun H => + (let (x,p) as u return (Q (existT _ (projT1 u) (projT2 u)) -> Q u) := u in fun x : Q (existT _ _ p) => x) H. (* success *) +Definition unpack_sigma {A} {P : A -> Type} (Q : sigT P -> Type) (u : sigT P) : + Q (existT _ (projT1 u) (projT2 u)) -> Q u + := + fun H => + (let (x,p) as u return (Q (existT _ (projT1 u) (projT2 u)) -> Q u) := u in fun x => x) H. +(* Toplevel input, characters 219-229: +Error: +In environment +A : Type +P : A -> Type +Q : sigT P -> Type +u : sigT P +H : Q {| projT1 := projT1 u; projT2 := projT2 u |} +x : A +p : P x +The term + "fun + x : Q + {| + projT1 := projT1 {| projT1 := x; projT2 := p |}; + projT2 := projT2 {| projT1 := x; projT2 := p |} |} => x" has type + "Q + {| + projT1 := projT1 {| projT1 := x; projT2 := p |}; + projT2 := projT2 {| projT1 := x; projT2 := p |} |} -> +... " +*) diff --git a/test-suite/bugs/closed/bug_3317.v b/test-suite/bugs/closed/bug_3317.v new file mode 100644 index 0000000000..7419916645 --- /dev/null +++ b/test-suite/bugs/closed/bug_3317.v @@ -0,0 +1,94 @@ +Set Implicit Arguments. +Module A. + Set Universe Polymorphism. + Set Primitive Projections. + Set Asymmetric Patterns. + Inductive paths {A} (x : A) : A -> Type := idpath : paths x x + where "x = y" := (@paths _ x y) : type_scope. + Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. + Arguments existT {A} _ _ _. + Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + Notation "x .1" := (projT1 x) (at level 3). + Notation "x .2" := (projT2 x) (at level 3). + Notation "( x ; y )" := (existT _ x y). + Set Printing All. + Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (pq : sigT (fun p : u.1 = v.1 => transport _ p u.2 = v.2)) + : u = v + := match pq with + | existT p q => + match u, v return (forall p0 : (u.1 = v.1), (transport P p0 u.2 = v.2) -> (u=v)) with + | (x;y), (x';y') => fun p1 (q1 : transport P p1 (existT P x y).2 = (existT P x' y').2) => + match p1 in (_ = x'') return (forall y'', (transport _ p1 y = y'') -> (x;y)=(x'';y'')) with + | idpath => fun y' (q2 : transport _ (@idpath _ _) y = y') => + match q2 in (_ = y'') return (x;y) = (x;y'') with + | idpath => @idpath _ _ + end + end y' q1 + end p q + end. + (* Toplevel input, characters 341-357: +Error: +In environment +A : Type +P : forall _ : A, Type +u : @sigT A P +v : @sigT A P +pq : +@sigT (@paths A (projT1 u) (projT1 v)) + (fun p : @paths A (projT1 u) (projT1 v) => + @paths (P (projT1 v)) (@transport A P (projT1 u) (projT1 v) p (projT2 u)) + (projT2 v)) +p : @paths A (projT1 u) (projT1 v) +q : +@paths (P (projT1 v)) (@transport A P (projT1 u) (projT1 v) p (projT2 u)) + (projT2 v) +x : A +y : P x +x' : A +y' : P x' +p1 : @paths A (projT1 (@existT A P x y)) (projT1 (@existT A P x' y')) +The term "projT2 (@existT A P x y)" has type "P (projT1 (@existT A P x y))" +while it is expected to have type "P (projT1 (@existT A P x y))". + *) +End A. + +Module B. + Set Universe Polymorphism. + Set Primitive Projections. + Set Asymmetric Patterns. + Inductive paths {A} (x : A) : A -> Type := idpath : paths x x + where "x = y" := (@paths _ x y) : type_scope. + Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. + Arguments existT {A} _ _ _. + Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + Notation "x .1" := (projT1 x) (at level 3). + Notation "x .2" := (projT2 x) (at level 3). + Notation "( x ; y )" := (existT _ x y). + Set Printing All. + + Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (pq : sigT (fun p : u.1 = v.1 => transport _ p u.2 = v.2)) + : u = v. + Proof. + destruct u as [x y]. + destruct v. (* Toplevel input, characters 0-11: +Error: Illegal application: +The term "transport" of type + "forall (A : Type) (P : forall _ : A, Type) (x y : A) + (_ : @paths A x y) (_ : P x), P y" +cannot be applied to the terms + "A" : "Type" + "P" : "forall _ : A, Type" + "projT1 (@existT A P x y)" : "A" + "projT1 v" : "A" + "p" : "@paths A (projT1 (@existT A P x y)) (projT1 v)" + "projT2 (@existT A P x y)" : "P (projT1 (@existT A P x y))" +The 5th term has type "@paths A (projT1 (@existT A P x y)) (projT1 v)" +which should be coercible to + "@paths A (projT1 (@existT A P x y)) (projT1 v)". + *) + Abort. +End B. diff --git a/test-suite/bugs/closed/bug_3319.v b/test-suite/bugs/closed/bug_3319.v new file mode 100644 index 0000000000..0b0aff29cb --- /dev/null +++ b/test-suite/bugs/closed/bug_3319.v @@ -0,0 +1,26 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 5353 lines to 4545 lines, then from 4513 lines to 4504 lines, then from 4515 lines to 4508 lines, then from 4519 lines to 132 lines, then from 111 lines to 66 lines, then from 68 lines to 35 lines *) +Set Implicit Arguments. +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a + where "x = y" := (@paths _ x y) : type_scope. + +Record PreCategory := { obj :> Type; morphism : obj -> obj -> Type }. +Record NotionOfStructure (X : PreCategory) := + { structure :> X -> Type; + is_structure_homomorphism + : forall x y (f : morphism X x y) (a : structure x) (b : structure y), Type }. + +Section precategory. + Variable X : PreCategory. + Variable P : NotionOfStructure X. + Local Notation object := { x : X & P x }. + Record morphism' (xa yb : object) := {}. + + Lemma issig_morphism xa yb + : { f : morphism X (projT1 xa) (projT1 yb) + & is_structure_homomorphism _ _ _ f (projT2 xa) (projT2 yb) } + = morphism' xa yb. + Proof. + admit. + Defined. diff --git a/test-suite/bugs/closed/bug_3320.v b/test-suite/bugs/closed/bug_3320.v new file mode 100644 index 0000000000..a5c243d8e3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3320.v @@ -0,0 +1,5 @@ +Goal forall x : nat, True. + fix goal 1. + assumption. +Fail Qed. +Undo. diff --git a/test-suite/bugs/closed/bug_3321.v b/test-suite/bugs/closed/bug_3321.v new file mode 100644 index 0000000000..b6f10e533e --- /dev/null +++ b/test-suite/bugs/closed/bug_3321.v @@ -0,0 +1,19 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 5302 lines to 4649 lines, then from 4660 lines to 355 lines, then from 360 lines to 269 lines, then from 269 lines to 175 lines, then from 144 lines to 119 lines, then from 103 lines to 83 lines, then from 86 lines to 36 lines, then from 37 lines to 17 lines *) + +Axiom admit : forall {T}, T. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. +Record Equiv A B := BuildEquiv { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. +Definition equiv_path (A B : Type) (p : A = B) : Equiv A B := admit. +Class Univalence := { isequiv_equiv_path :> forall (A B : Type), IsEquiv (equiv_path A B) }. +Definition path_universe `{Univalence} {A B : Type} (f : A -> B) {feq : IsEquiv f} : (A = B) := admit. +Context `{ua:Univalence}. +Variable A:Type. +Goal forall (I : Type) (f : I -> A), + {p : I = {a : A & @hfiber I A f a} & True }. +intros. +clear. +try exists (path_universe admit). (* Toplevel input, characters 15-44: +Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/bug_3322.v b/test-suite/bugs/closed/bug_3322.v new file mode 100644 index 0000000000..ab3025a6aa --- /dev/null +++ b/test-suite/bugs/closed/bug_3322.v @@ -0,0 +1,24 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 11971 lines to 11753 lines, then from 7702 lines to 564 lines, then from 571 lines to 61 lines *) +Set Asymmetric Patterns. +Axiom admit : forall {T}, T. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (pq : {p : (projT1 u) = (projT1 v) & transport _ p (projT2 u) = (projT2 v)}) +: u = v. +Proof. + destruct pq as [p q], u as [x y], v as [x' y']; simpl in *. + destruct p, q; simpl; reflexivity. +Defined. +Arguments path_sigma_uncurried : simpl never. +Section opposite. + Let opposite_functor_involutive_helper + := @path_sigma_uncurried admit admit (existT _ admit admit) admit (existT _ admit admit). + + Goal True. + Opaque path_sigma_uncurried. + simpl in *. + Transparent path_sigma_uncurried. + (* This command should fail with "Error: Failed to progress.", as it does in 8.4; the simpl never directive should prevent simpl from progressing *) + Fail progress simpl in *. diff --git a/test-suite/bugs/closed/bug_3323.v b/test-suite/bugs/closed/bug_3323.v new file mode 100644 index 0000000000..4622634eaa --- /dev/null +++ b/test-suite/bugs/closed/bug_3323.v @@ -0,0 +1,78 @@ +Require Import TestSuite.admit. +(* -*- coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 5302 lines to 4649 lines, then from 4660 lines to 355 lines, then from 360 lines to 269 lines, then from 269 lines to 175 lines, then from 144 lines to 119 lines, then from 297 lines to 117 lines, then from 95 lines to 79 lines, then from 82 lines to 68 lines *) + +Set Universe Polymorphism. +Generalizable All Variables. +Inductive sigT {A:Type} (P:A -> Type) : Type := existT : forall x:A, P x -> sigT P. +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. +Definition projT1 {A} {P : A -> Type} (x : sigT P) : A := let (a, _) := x in a. +Definition projT2 {A} {P : A -> Type} (x : sigT P) : P (projT1 x) := let (a, h) return P (projT1 x) := x in h. +Axiom admit : forall {T}, T. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. +Record Equiv A B := BuildEquiv { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Existing Instance equiv_isequiv. +Global Instance isequiv_inverse `{IsEquiv A B f} : IsEquiv (@equiv_inv _ _ f _) | 10000 := admit. +Definition equiv_path_sigma `(P : A -> Type) (u v : sigT P) +: Equiv {p : projT1 u = projT1 v & transport _ p (projT2 u) = projT2 v} (u = v) := admit. +Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. +Definition path_universe {A B : Type} (f : A -> B) : (A = B) := admit. +Section AssumeFunext. + Let equiv_fibration_replacement_eissect {B C f} + : forall x : {y : B & {x : C & f x = y}}, + existT _ (f (projT1 (projT2 x))) (existT _ (projT1 (projT2 x)) idpath) = x. + admit. + Defined. + Definition equiv_fibration_replacement {B C} (f:C ->B): + Equiv C {y:B & {x:C & f x = y}}. + Proof. + refine (BuildEquiv + _ _ _ + (BuildIsEquiv + C {y:B & {x:C & f x = y}} + (fun c => existT _ (f c) (existT _ c idpath)) + (fun c => projT1 (projT2 c)) + equiv_fibration_replacement_eissect)). + Defined. + Definition equiv_total_paths (A : Type) (P : A-> Type) (x y : sigT P) : + Equiv (x = y) { p : projT1 x = projT1 y & transport P p (projT2 x) = (projT2 y) } + := BuildEquiv _ _ (@equiv_inv _ _ _ (equiv_path_sigma P x y)) _. + Variable A:Type. + Definition Fam A:=sigT (fun I:Type => I->A). + Definition p2f: (A->Type)-> Fam A := fun Q:(A->Type) => existT _ (sigT Q) (@projT1 _ _). + Definition f2p: Fam A -> (A->Type) := fun F => let (I, f) := F in (fun a => (hfiber f a)). + Definition exp {U V:Type}(w:Equiv U V):Equiv (U->A) (V->A). + exists (fun f:(U->A)=> (fun x => (f (@equiv_inv _ _ w _ x)))). + admit. + Defined. + Goal { h : Fam A -> A -> Type & Sect h p2f }. + exists f2p. + intros [I f]. + set (e:=@equiv_total_paths _ _ (@existT Type (fun I0 : Type => I0 -> A) I f) + (existT _ {a : A & hfiber f a} (@projT1 _ _))). + simpl in e. + cut ( {p : I = {a : A & @hfiber I A f a} & + @transport _ (fun I0 : Type => I0 -> A) _ _ p f = @projT1 _ _}). + { intro X. + apply (inverse (@equiv_inv _ _ _ e X)). } + set (w:=@equiv_fibration_replacement A I f). + exists (path_universe w). + assert (forall x, (exp w) f x = projT1 x); [ | admit ]. + intros [a [i p]]. + exact p. + Qed. +(* Toplevel input, characters 15-19: +Error: In pattern-matching on term "x" the branch for constructor +"existT(*Top.256 Top.258*)" has type + "forall (I : Type) (f : I -> A), + existT (fun I0 : Type => I0 -> A) {a : A & hfiber f a} projT1 = + existT (fun I0 : Type => I0 -> A) I f" which should be + "forall (x : Type) (H : x -> A), + p2f (f2p (existT (fun I : Type => I -> A) x H)) = + existT (fun I : Type => I -> A) x H". + *) diff --git a/test-suite/bugs/closed/bug_3324.v b/test-suite/bugs/closed/bug_3324.v new file mode 100644 index 0000000000..45dbb57aa2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3324.v @@ -0,0 +1,48 @@ +Require Import TestSuite.admit. +Module ETassi. + Axiom admit : forall {T}, T. + Class IsHProp (A : Type) : Type := {}. + Class IsHSet (A : Type) : Type := {}. + Record hProp := hp { hproptype :> Type ; isp : IsHProp hproptype}. + Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. + Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). + Global Instance isset_hProp : IsHSet hProp | 0. + + Check (eq_refl _ : setT (default_HSet _ _) = hProp). + Check (eq_refl _ : setT _ = hProp). +End ETassi. + +Module JGross. + (* File reduced by coq-bug-finder from original input, then from 6462 lines to 5760 lines, then from 5761 lines to 181 lines, then from 191 lines to 181 lines, then from 181 lines to 83 lines, then from 87 lines to 27 lines *) + Axiom admit : forall {T}, T. + Class IsHProp (A : Type) : Type := {}. + Class IsHSet (A : Type) : Type := {}. + Inductive Unit : Set := tt. + Record hProp := hp { hproptype :> Type ; isp : IsHProp hproptype}. + Definition Unit_hp:hProp:=(hp Unit admit). + Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. + Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). + Global Instance isset_hProp : IsHSet hProp | 0. + Definition isepi {X Y} `(f:X->Y) := forall Z: hSet, + forall g h: Y -> Z, (fun x => g (f x)) = (fun x => h (f x)) -> g = h. + Lemma isepi_issurj {X Y} (f:X->Y): isepi f -> True. + Proof. + intros epif. + set (g :=fun _:Y => Unit_hp). + pose proof (epif (default_HSet hProp isset_hProp) g). + specialize (epif _ g). + (* Toplevel input, characters 34-35: +Error: +In environment +X : Type +Y : Type +f : X -> Y +epif : isepi f +g := fun _ : Y => Unit_hp : Y -> hProp +H : forall h : Y -> default_HSet hProp isset_hProp, + (fun x : X => g (f x)) = (fun x : X => h (f x)) -> g = h +The term "g" has type "Y -> hProp" while it is expected to have type + "Y -> ?30". + *) + Abort. +End JGross. diff --git a/test-suite/bugs/closed/bug_3325.v b/test-suite/bugs/closed/bug_3325.v new file mode 100644 index 0000000000..36c065ebe8 --- /dev/null +++ b/test-suite/bugs/closed/bug_3325.v @@ -0,0 +1,48 @@ +Typeclasses eauto := debug. +Set Printing All. + +Axiom SProp : Set. +Axiom sp : SProp. + +(* If we hardcode valueType := nat, it goes through *) +Class StateIs := { + valueType : Type; + stateIs : valueType -> SProp +}. + +Instance NatStateIs : StateIs := { + valueType := nat; + stateIs := fun _ => sp +}. +Canonical Structure NatStateIs. + +Class LogicOps F := { land: F -> F }. +Instance : LogicOps SProp. Admitted. +Instance : LogicOps Prop. Admitted. + +Parameter (n : nat). +(* If this is a [Definition], the resolution goes through fine. *) +Notation vn := (@stateIs _ n). +Definition vn' := (@stateIs _ n). +Definition GOOD : SProp := + @land _ _ vn'. +(* This doesn't resolve, if PropLogicOps is defined later than SPropLogicOps *) +Definition BAD : SProp := + @land _ _ vn. + + +Class A T := { foo : T -> Prop }. +Instance: A nat. Admitted. +Instance: A Set. Admitted. + +Class B := { U : Type ; b : U }. +Instance bi: B := {| U := nat ; b := 0 |}. +Canonical Structure bi. + +Notation b0N := (@b _ : nat). +Notation b0Ni := (@b bi : nat). +Definition b0D := (@b _ : nat). +Definition GOOD1 := (@foo _ _ b0D). +Definition GOOD2 := (let x := b0N in @foo _ _ x). +Definition GOOD3 := (@foo _ _ b0Ni). +Definition BAD1 := (@foo _ _ b0N). (* Error: The term "b0Ni" has type "nat" while it is expected to have type "Set". *) diff --git a/test-suite/bugs/closed/bug_3326.v b/test-suite/bugs/closed/bug_3326.v new file mode 100644 index 0000000000..f0d8cbf704 --- /dev/null +++ b/test-suite/bugs/closed/bug_3326.v @@ -0,0 +1,19 @@ +Class ORDER A := Order { + LEQ : A -> A -> bool; + leqRefl: forall x, true = LEQ x x +}. + +Section XXX. + +Variable A:Type. +Variable (O:ORDER A). +Definition aLeqRefl := @leqRefl _ O. + +Lemma OK : forall x, true = LEQ x x. +Proof. + intros. + unfold LEQ. + destruct O. + clear. + Fail apply aLeqRefl. +Abort. diff --git a/test-suite/bugs/closed/bug_3329.v b/test-suite/bugs/closed/bug_3329.v new file mode 100644 index 0000000000..ecb09e8436 --- /dev/null +++ b/test-suite/bugs/closed/bug_3329.v @@ -0,0 +1,94 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 12095 lines to 869 lines, then from 792 lines to 504 lines, then from 487 lines to 353 lines, then from 258 lines to 174 lines, then from 164 lines to 132 lines, then from 129 lines to 99 lines *) +Set Universe Polymorphism. +Generalizable All Variables. +Axiom admit : forall {T}, T. +Reserved Notation "g 'o' f" (at level 40, left associativity). +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Notation "g 'o' f" := (compose g f). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) : Type := forall x:A, f x = g x. +Hint Unfold pointwise_paths : typeclass_instances. +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) +: forall x, f x = g x + := fun x => match h with idpath => idpath end. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A }. +Class IsHSet (A : Type) := { _ : False }. +Class Funext := { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + trunc_morphism : forall s d, IsHSet (morphism s d) }. + +Definition trunc_equiv `(f : A -> B) `{IsHSet A} `{IsEquiv A B f} : IsHSet B := admit. +Global Instance trunc_forall `{Funext} `{P : A -> Type} `{forall a, IsHSet (P a)} +: IsHSet (forall a, P a) | 100. +Proof. + generalize dependent P. + intro P. + assert (f : forall a, P a) by admit. + assert (g : forall a, P a) by admit. + pose (@trunc_equiv (forall x : A, @paths (P x) (f x) (g x)) + (@paths (forall x : A, P x) f g) + (@equiv_inv (@paths (forall x : A, P x) f g) + (forall x : A, @paths (P x) (f x) (g x)) + (@apD10 A P f g) (@isequiv_apD10 H A P f g))). + admit. +Defined. +Record Functor (C D : PreCategory) := { object_of :> C -> D }. +Definition identity C : Functor C C := Build_Functor C C admit. +Notation "1" := (identity _) : functor_scope. +Definition functor_category (C D : PreCategory) : PreCategory + := @Build_PreCategory (Functor C D) admit admit. +Notation "C -> D" := (functor_category C D) : category_scope. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. +Global Existing Instance iss. +Definition set_cat `{Funext} : PreCategory := + @Build_PreCategory hSet + (fun x y => x -> y) + _. + +Section hom_functor. + Context `{Funext}. + Variable C : PreCategory. + + Local Notation obj_of c'c := + (BuildhSet + (morphism + C + c'c + c'c) + admit). + Let hom_functor_morphism_of s's d'd (hf : morphism C s's d'd) + : morphism set_cat (obj_of s's) (obj_of d'd) + := admit. + + Definition hom_functor : Functor C set_cat := admit. +End hom_functor. +Local Open Scope category_scope. +Local Open Scope functor_scope. +Context `{Funext}. +Variable D : PreCategory. +Set Printing Universes. +Check hom_functor D o 1. +(* Toplevel input, characters 20-44: +Error: Illegal application: +The term "@set_cat" of type "(Funext -> PreCategory)%type" +cannot be applied to the term + "H" : "Funext" +This term has type "Funext" which should be coercible to +"Funext". *) +(* The command has indeed failed with message: +=> Error: Illegal application: +The term "@set_cat@{Top.345 Top.346 Top.331 Top.332 Top.337 Top.338 Top.339}" +of type + "(Funext@{Top.346 Top.346 Top.331 Top.332 Top.346} -> PreCategory@{Top.345 + Top.346})%type" +cannot be applied to the term + "H@{Top.346 Top.330 Top.331 Top.332 Top.333}" + : "Funext@{Top.346 Top.330 Top.331 Top.332 Top.333}" +This term has type "Funext@{Top.346 Top.330 Top.331 Top.332 Top.333}" +which should be coercible to + "Funext@{Top.346 Top.346 Top.331 Top.332 Top.346}". +*) diff --git a/test-suite/bugs/closed/bug_3330.v b/test-suite/bugs/closed/bug_3330.v new file mode 100644 index 0000000000..ae55ba59f6 --- /dev/null +++ b/test-suite/bugs/closed/bug_3330.v @@ -0,0 +1,1115 @@ +Unset Strict Universe Declaration. +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 12106 lines to 1070 lines *) +Set Universe Polymorphism. +Definition setleq (A : Type@{i}) (B : Type@{j}) := A : Type@{j}. + +Inductive foo : Type@{l} := bar : foo . +Section MakeEq. + Variables (a : foo@{i}) (b : foo@{j}). + + Let t := ltac:(let ty := type of b in exact ty). + Definition make_eq (x:=b) := a : t. +End MakeEq. + +Definition same (x : foo@{i}) (y : foo@{i}) := x. + +Section foo. + + Variables x : foo@{i}. + Variables y : foo@{j}. + + Let AleqB := let foo := make_eq x y in (Type * Type)%type. + + Definition baz := same x y. +End foo. + +Definition baz' := Eval unfold baz in baz@{i j k l}. + +Module Export HoTT_DOT_Overture. +Module Export HoTT. +Module Export Overture. + +Definition relation (A : Type) := A -> A -> Type. +Class Symmetric {A} (R : relation A) := + symmetry : forall x y, R x y -> R y x. + +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := + fun x => g (f x). + +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. + +Open Scope function_scope. + +Set Printing Universes. Set Printing All. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. + +Notation "x = y" := (x = y :>_) : type_scope. + +Delimit Scope path_scope with path. + +Local Open Scope path_scope. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Instance symmetric_paths {A} : Symmetric (@paths A) | 0 := @inverse A. + +Notation "1" := idpath : path_scope. + +Notation "p @ q" := (concat p q) (at level 20) : path_scope. + +Notation "p ^" := (inverse p) (at level 3) : path_scope. + +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) : Type + := forall x:A, f x = g x. + +Hint Unfold pointwise_paths : typeclass_instances. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) + : f == g + := fun x => match h with idpath => 1 end. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) +}. + +Delimit Scope equiv_scope with equiv. + +Local Open Scope equiv_scope. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) +}. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Fixpoint nat_to_trunc_index (n : nat) : trunc_index + := match n with + | 0 => trunc_S (trunc_S minus_two) + | S n' => trunc_S (nat_to_trunc_index n') + end. + +Coercion nat_to_trunc_index : nat >-> trunc_index. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Notation IsHSet := (IsTrunc 0). + +Class Funext := + { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. + +Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x) : + f == g -> f = g + := + (@apD10 A P f g)^-1. + +End Overture. + +End HoTT. + +End HoTT_DOT_Overture. + +Module Export HoTT_DOT_categories_DOT_Category_DOT_Core. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Delimit Scope morphism_scope with morphism. + +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. +Set Printing Universes. +Set Printing All. +Record PreCategory := + Build_PreCategory' { + object :> Type; + morphism : object -> object -> Type; + + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g); + + associativity : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + (m3 o m2) o m1 = m3 o (m2 o m1); + + associativity_sym : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + m3 o (m2 o m1) = (m3 o m2) o m1; + + left_identity : forall a b (f : morphism a b), identity b o f = f; + right_identity : forall a b (f : morphism a b), f o identity a = f; + + identity_identity : forall x, identity x o identity x = identity x; + + trunc_morphism : forall s d, IsHSet (morphism s d) + }. + +Bind Scope category_scope with PreCategory. + +Arguments identity [!C%category] x%object : rename. +Arguments compose [!C%category s%object d%object d'%object] m1%morphism m2%morphism : rename. + +Definition Build_PreCategory + object morphism compose identity + associativity left_identity right_identity + := @Build_PreCategory' + object + morphism + compose + identity + associativity + (fun _ _ _ _ _ _ _ => symmetry _ _ (associativity _ _ _ _ _ _ _)) + left_identity + right_identity + (fun _ => left_identity _ _ _). + +Existing Instance trunc_morphism. + +Hint Resolve @left_identity @right_identity @associativity : category morphism. + +Module Export CategoryCoreNotations. + + Infix "o" := compose : morphism_scope. +End CategoryCoreNotations. +End Core. + +End Category. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Category_DOT_Core. + +Module Export HoTT_DOT_types_DOT_Forall. + +Module Export HoTT. +Module Export types. +Module Export Forall. +Generalizable Variables A B f g e n. + +Section AssumeFunext. + +Global Instance trunc_forall `{P : A -> Type} `{forall a, IsTrunc n (P a)} + : IsTrunc n (forall a, P a) | 100. + +admit. +Defined. +End AssumeFunext. + +End Forall. + +End types. + +End HoTT. + +End HoTT_DOT_types_DOT_Forall. + +Module Export HoTT_DOT_types_DOT_Prod. + +Module Export HoTT. +Module Export types. +Module Export Prod. +Local Open Scope path_scope. + +Definition path_prod_uncurried {A B : Type} (z z' : A * B) + (pq : (fst z = fst z') * (snd z = snd z')) + : (z = z') + := match pq with (p,q) => + match z, z' return + (fst z = fst z') -> (snd z = snd z') -> (z = z') with + | (a,b), (a',b') => fun p q => + match p, q with + idpath, idpath => 1 + end + end p q + end. + +Definition path_prod {A B : Type} (z z' : A * B) : + (fst z = fst z') -> (snd z = snd z') -> (z = z') + := fun p q => path_prod_uncurried z z' (p,q). + +Definition path_prod' {A B : Type} {x x' : A} {y y' : B} + : (x = x') -> (y = y') -> ((x,y) = (x',y')) + := fun p q => path_prod (x,y) (x',y') p q. + +End Prod. + +End types. + +End HoTT. + +End HoTT_DOT_types_DOT_Prod. + +Module Export HoTT_DOT_categories_DOT_Functor_DOT_Core. + +Module Export HoTT. +Module Export categories. +Module Export Functor. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Delimit Scope functor_scope with functor. + +Local Open Scope morphism_scope. + +Section Functor. + + Variable C : PreCategory. + Variable D : PreCategory. + + Record Functor := + { + object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d); + composition_of : forall s d d' + (m1 : morphism C s d) (m2: morphism C d d'), + morphism_of _ _ (m2 o m1) + = (morphism_of _ _ m2) o (morphism_of _ _ m1); + identity_of : forall x, morphism_of _ _ (identity x) + = identity (object_of x) + }. + +End Functor. +Bind Scope functor_scope with Functor. + +Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. +Module Export FunctorCoreNotations. + + Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. +End FunctorCoreNotations. +End Core. + +End Functor. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Functor_DOT_Core. + +Module Export HoTT_DOT_categories_DOT_Category_DOT_Morphisms. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Morphisms. +Set Universe Polymorphism. + +Local Open Scope morphism_scope. + +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := + { + morphism_inverse : morphism C d s; + left_inverse : morphism_inverse o m = identity _; + right_inverse : m o morphism_inverse = identity _ + }. + +Class Isomorphic {C : PreCategory} s d := + { + morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic + }. + +Module Export CategoryMorphismsNotations. + + Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. + +End CategoryMorphismsNotations. +End Morphisms. + +End Category. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Category_DOT_Morphisms. + +Module Export HoTT_DOT_categories_DOT_Category_DOT_Dual. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Dual. +Set Universe Polymorphism. + +Local Open Scope morphism_scope. + +Section opposite. + + Definition opposite (C : PreCategory) : PreCategory + := @Build_PreCategory' + C + (fun s d => morphism C d s) + (identity (C := C)) + (fun _ _ _ m1 m2 => m2 o m1) + (fun _ _ _ _ _ _ _ => @associativity_sym _ _ _ _ _ _ _ _) + (fun _ _ _ _ _ _ _ => @associativity _ _ _ _ _ _ _ _) + (fun _ _ => @right_identity _ _ _) + (fun _ _ => @left_identity _ _ _) + (@identity_identity C) + _. +End opposite. + +Module Export CategoryDualNotations. + + Notation "C ^op" := (opposite C) (at level 3) : category_scope. +End CategoryDualNotations. +End Dual. + +End Category. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Category_DOT_Dual. + +Module Export HoTT_DOT_categories_DOT_Functor_DOT_Composition_DOT_Core. + +Module Export HoTT. +Module Export categories. +Module Export Functor. +Module Export Composition. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope morphism_scope. + +Section composition. + + Variable C : PreCategory. + Variable D : PreCategory. + Variable E : PreCategory. + Variable G : Functor D E. + Variable F : Functor C D. + + Local Notation c_object_of c := (G (F c)) (only parsing). + + Local Notation c_morphism_of m := (morphism_of G (morphism_of F m)) (only parsing). + + Let compose_composition_of' s d d' + (m1 : morphism C s d) (m2 : morphism C d d') + : c_morphism_of (m2 o m1) = c_morphism_of m2 o c_morphism_of m1. +admit. +Defined. + Definition compose_composition_of s d d' m1 m2 + := Eval cbv beta iota zeta delta + [compose_composition_of'] in + @compose_composition_of' s d d' m1 m2. + Let compose_identity_of' x + : c_morphism_of (identity x) = identity (c_object_of x). + +admit. +Defined. + Definition compose_identity_of x + := Eval cbv beta iota zeta delta + [compose_identity_of'] in + @compose_identity_of' x. + Definition compose : Functor C E + := Build_Functor + C E + (fun c => G (F c)) + (fun _ _ m => morphism_of G (morphism_of F m)) + compose_composition_of + compose_identity_of. + +End composition. +Module Export FunctorCompositionCoreNotations. + + Infix "o" := compose : functor_scope. +End FunctorCompositionCoreNotations. +End Core. + +End Composition. + +End Functor. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Functor_DOT_Composition_DOT_Core. + +Module Export HoTT_DOT_categories_DOT_Functor_DOT_Dual. + +Module Export HoTT. +Module Export categories. +Module Export Functor. +Module Export Dual. +Set Universe Polymorphism. + +Set Implicit Arguments. + +Section opposite. + + Variable C : PreCategory. + Variable D : PreCategory. + Definition opposite (F : Functor C D) : Functor C^op D^op + := Build_Functor (C^op) (D^op) + (object_of F) + (fun s d => morphism_of F (s := d) (d := s)) + (fun d' d s m1 m2 => composition_of F s d d' m2 m1) + (identity_of F). + +End opposite. +Module Export FunctorDualNotations. + + Notation "F ^op" := (opposite F) : functor_scope. +End FunctorDualNotations. +End Dual. + +End Functor. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Functor_DOT_Dual. + +Module Export HoTT_DOT_categories_DOT_Functor_DOT_Identity. + +Module Export HoTT. +Module Export categories. +Module Export Functor. +Module Export Identity. +Set Universe Polymorphism. + +Section identity. + + Definition identity C : Functor C C + := Build_Functor C C + (fun x => x) + (fun _ _ x => x) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). +End identity. +Module Export FunctorIdentityNotations. + + Notation "1" := (identity _) : functor_scope. +End FunctorIdentityNotations. +End Identity. + +End Functor. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Functor_DOT_Identity. + +Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Core. + +Module Export HoTT. +Module Export categories. +Module Export NaturalTransformation. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope morphism_scope. + +Section NaturalTransformation. + + Variable C : PreCategory. + Variable D : PreCategory. + Variables F G : Functor C D. + + Record NaturalTransformation := + Build_NaturalTransformation' { + components_of :> forall c, morphism D (F c) (G c); + commutes : forall s d (m : morphism C s d), + components_of d o F _1 m = G _1 m o components_of s; + + commutes_sym : forall s d (m : C.(morphism) s d), + G _1 m o components_of s = components_of d o F _1 m + }. + +End NaturalTransformation. +End Core. + +End NaturalTransformation. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Core. + +Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Dual. + +Module Export HoTT. +Module Export categories. +Module Export NaturalTransformation. +Module Export Dual. +Set Universe Polymorphism. + +Section opposite. + + Variable C : PreCategory. + Variable D : PreCategory. + + Definition opposite + (F G : Functor C D) + (T : NaturalTransformation F G) + : NaturalTransformation G^op F^op + := Build_NaturalTransformation' (G^op) (F^op) + (components_of T) + (fun s d => commutes_sym T d s) + (fun s d => commutes T d s). + +End opposite. + +End Dual. + +End NaturalTransformation. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Dual. + +Module Export HoTT_DOT_categories_DOT_Category_DOT_Strict. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Strict. + +Export Category.Core. +Set Universe Polymorphism. + +End Strict. + +End Category. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Category_DOT_Strict. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Prod. +Set Universe Polymorphism. + +Local Open Scope morphism_scope. + +Section prod. + + Variable C : PreCategory. + Variable D : PreCategory. + Definition prod : PreCategory. + + refine (@Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) + * morphism D (snd s) (snd d))%type) + (fun x => (identity (fst x), identity (snd x))) + (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1)) + _ + _ + _ + _); admit. + Defined. +End prod. +Module Export CategoryProdNotations. + + Infix "*" := prod : category_scope. +End CategoryProdNotations. +End Prod. + +End Category. + +End categories. + +End HoTT. + +Module Functor. +Module Export Prod. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope morphism_scope. + +Section proj. + + Context {C : PreCategory}. + Context {D : PreCategory}. + Definition fst : Functor (C * D) C + := Build_Functor (C * D) C + (@fst _ _) + (fun _ _ => @fst _ _) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). + + Definition snd : Functor (C * D) D + := Build_Functor (C * D) D + (@snd _ _) + (fun _ _ => @snd _ _) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). + +End proj. + +Section prod. + + Variable C : PreCategory. + Variable D : PreCategory. + Variable D' : PreCategory. + Definition prod (F : Functor C D) (F' : Functor C D') + : Functor C (D * D') + := Build_Functor + C (D * D') + (fun c => (F c, F' c)) + (fun s d m => (F _1 m, F' _1 m)) + (fun _ _ _ _ _ => path_prod' (composition_of F _ _ _ _ _) + (composition_of F' _ _ _ _ _)) + (fun _ => path_prod' (identity_of F _) (identity_of F' _)). + +End prod. +Local Infix "*" := prod : functor_scope. + +Section pair. + + Variable C : PreCategory. + Variable D : PreCategory. + Variable C' : PreCategory. + Variable D' : PreCategory. + Variable F : Functor C D. + Variable F' : Functor C' D'. + Definition pair : Functor (C * C') (D * D') + := (F o fst) * (F' o snd). + +End pair. + +Module Export FunctorProdNotations. + + Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : functor_scope. +End FunctorProdNotations. +End Prod. + +End Functor. + +Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core. + +Module Export HoTT. +Module categories. +Module Export NaturalTransformation. +Module Export Composition. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope path_scope. + +Local Open Scope morphism_scope. + +Section composition. + + Section compose. + Variable C : PreCategory. + Variable D : PreCategory. + Variables F F' F'' : Functor C D. + Variable T' : NaturalTransformation F' F''. + + Variable T : NaturalTransformation F F'. + Local Notation CO c := (T' c o T c). + + Definition compose_commutes s d (m : morphism C s d) + : CO d o morphism_of F m = morphism_of F'' m o CO s + := (associativity _ _ _ _ _ _ _ _) + @ ap (fun x => _ o x) (commutes T _ _ m) + @ (associativity_sym _ _ _ _ _ _ _ _) + @ ap (fun x => x o _) (commutes T' _ _ m) + @ (associativity _ _ _ _ _ _ _ _). + + Definition compose_commutes_sym s d (m : morphism C s d) + : morphism_of F'' m o CO s = CO d o morphism_of F m + := (associativity_sym _ _ _ _ _ _ _ _) + @ ap (fun x => x o _) (commutes_sym T' _ _ m) + @ (associativity _ _ _ _ _ _ _ _) + @ ap (fun x => _ o x) (commutes_sym T _ _ m) + @ (associativity_sym _ _ _ _ _ _ _ _). + + Definition compose + : NaturalTransformation F F'' + := Build_NaturalTransformation' F F'' + (fun c => CO c) + compose_commutes + compose_commutes_sym. + + End compose. + End composition. +Module Export NaturalTransformationCompositionCoreNotations. + + Infix "o" := compose : natural_transformation_scope. +End NaturalTransformationCompositionCoreNotations. +End Core. + +End Composition. + +End NaturalTransformation. + +End categories. + +Set Universe Polymorphism. + +Section path_natural_transformation. + + Context `{Funext}. + Variable C : PreCategory. + + Variable D : PreCategory. + Variables F G : Functor C D. + + Global Instance trunc_natural_transformation + : IsHSet (NaturalTransformation F G). + +admit. +Defined. + Section path. + + Variables T U : NaturalTransformation F G. + + Lemma path'_natural_transformation + : components_of T = components_of U + -> T = U. + +admit. +Defined. + Lemma path_natural_transformation + : components_of T == components_of U + -> T = U. + + Proof. + intros. + apply path'_natural_transformation. + apply path_forall; assumption. + Qed. + End path. +End path_natural_transformation. + +Ltac path_natural_transformation := + repeat match goal with + | _ => intro + | _ => apply path_natural_transformation; simpl + end. + +Module Export Identity. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope morphism_scope. + +Local Open Scope path_scope. +Section identity. + + Variable C : PreCategory. + Variable D : PreCategory. + + Section generalized. + + Variables F G : Functor C D. + Hypothesis HO : object_of F = object_of G. + Hypothesis HM : transport (fun GO => forall s d, + morphism C s d + -> morphism D (GO s) (GO d)) + HO + (morphism_of F) + = morphism_of G. + Local Notation CO c := (transport (fun GO => morphism D (F c) (GO c)) + HO + (identity (F c))). + + Definition generalized_identity_commutes s d (m : morphism C s d) + : CO d o morphism_of F m = morphism_of G m o CO s. + + Proof. + case HM. +case HO. + exact (left_identity _ _ _ _ @ (right_identity _ _ _ _)^). + Defined. + Definition generalized_identity_commutes_sym s d (m : morphism C s d) + : morphism_of G m o CO s = CO d o morphism_of F m. + +admit. +Defined. + Definition generalized_identity + : NaturalTransformation F G + := Build_NaturalTransformation' + F G + (fun c => CO c) + generalized_identity_commutes + generalized_identity_commutes_sym. + + End generalized. + Definition identity (F : Functor C D) + : NaturalTransformation F F + := Eval simpl in @generalized_identity F F 1 1. + +End identity. +Module Export NaturalTransformationIdentityNotations. + + Notation "1" := (identity _) : natural_transformation_scope. +End NaturalTransformationIdentityNotations. +End Identity. + +Module Export Laws. +Import HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core.HoTT.categories. +Set Universe Polymorphism. + +Local Open Scope natural_transformation_scope. +Section natural_transformation_identity. + + Context `{fs : Funext}. + Variable C : PreCategory. + + Variable D : PreCategory. + + Lemma left_identity (F F' : Functor C D) + (T : NaturalTransformation F F') + : 1 o T = T. + + Proof. + path_natural_transformation; auto with morphism. + Qed. + + Lemma right_identity (F F' : Functor C D) + (T : NaturalTransformation F F') + : T o 1 = T. + + Proof. + path_natural_transformation; auto with morphism. + Qed. +End natural_transformation_identity. +Section associativity. + + Section nt. + + Context `{fs : Funext}. + Definition associativity + C D F G H I + (V : @NaturalTransformation C D F G) + (U : @NaturalTransformation C D G H) + (T : @NaturalTransformation C D H I) + : (T o U) o V = T o (U o V). + + Proof. + path_natural_transformation. + apply associativity. + Qed. + End nt. +End associativity. +End Laws. + +Module Export FunctorCategory. +Module Export Core. +Import HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core.HoTT.categories. +Set Universe Polymorphism. + +Section functor_category. + + Context `{Funext}. + Variable C : PreCategory. + + Variable D : PreCategory. + + Definition functor_category : PreCategory + := @Build_PreCategory (Functor C D) + (@NaturalTransformation C D) + (@identity C D) + (@compose C D) + (@associativity _ C D) + (@left_identity _ C D) + (@right_identity _ C D) + _. + +End functor_category. +Module Export FunctorCategoryCoreNotations. + + Notation "C -> D" := (functor_category C D) : category_scope. +End FunctorCategoryCoreNotations. +End Core. + +End FunctorCategory. + +Module Export Morphisms. +Set Universe Polymorphism. + +Set Implicit Arguments. + +Definition NaturalIsomorphism `{Funext} (C D : PreCategory) F G := + @Isomorphic (C -> D) F G. + +Module Export FunctorCategoryMorphismsNotations. + + Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. +End FunctorCategoryMorphismsNotations. +End Morphisms. + +Module Export HSet. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. + +Global Existing Instance iss. +End HSet. + +Module Export Core. +Set Universe Polymorphism. + +Notation cat_of obj := + (@Build_PreCategory obj + (fun x y => x -> y) + (fun _ x => x) + (fun _ _ _ f g => f o g)%core + (fun _ _ _ _ _ _ _ => idpath) + (fun _ _ _ => idpath) + (fun _ _ _ => idpath) + _). + +Definition set_cat `{Funext} : PreCategory := cat_of hSet. +Set Universe Polymorphism. + +Local Open Scope morphism_scope. + +Section hom_functor. + + Context `{Funext}. + Variable C : PreCategory. + Local Notation obj_of c'c := + (BuildhSet + (morphism + C + (fst (c'c : object (C^op * C))) + (snd (c'c : object (C^op * C)))) + _). + + Let hom_functor_morphism_of s's d'd (hf : morphism (C^op * C) s's d'd) + : morphism set_cat (obj_of s's) (obj_of d'd) + := fun g => snd hf o g o fst hf. + + Definition hom_functor : Functor (C^op * C) set_cat. + + refine (Build_Functor (C^op * C) set_cat + (fun c'c => obj_of c'c) + hom_functor_morphism_of + _ + _); + subst hom_functor_morphism_of; + simpl; admit. + Defined. +End hom_functor. +Set Universe Polymorphism. + +Import Category.Dual Functor.Dual. +Import Category.Prod Functor.Prod. +Import Functor.Composition.Core. +Import Functor.Identity. +Set Universe Polymorphism. + +Local Open Scope functor_scope. +Local Open Scope natural_transformation_scope. +Section Adjunction. + + Context `{Funext}. + Variable C : PreCategory. + Variable D : PreCategory. + Variable F : Functor C D. + Variable G : Functor D C. + + Let Adjunction_Type := + Eval simpl in (hom_functor D) o (F^op, 1) <~=~> (hom_functor C) o (1, G). + + Record AdjunctionHom := + { + mate_of : + @NaturalIsomorphism H + (Prod.prod (Category.Dual.opposite C) D) + (@set_cat H) + (@compose (Prod.prod (Category.Dual.opposite C) D) + (Prod.prod (Category.Dual.opposite D) D) + (@set_cat H) (@hom_functor H D) + (@pair (Category.Dual.opposite C) + (Category.Dual.opposite D) D D + (@opposite C D F) (identity D))) + (@compose (Prod.prod (Category.Dual.opposite C) D) + (Prod.prod (Category.Dual.opposite C) C) + (@set_cat H) (@hom_functor H C) + (@pair (Category.Dual.opposite C) + (Category.Dual.opposite C) D C + (identity (Category.Dual.opposite C)) G)) + }. +End Adjunction. +(* Error: Illegal application: +The term "NaturalIsomorphism" of type + "forall (H : Funext) (C D : PreCategory), + (C -> D)%category -> (C -> D)%category -> Type" +cannot be applied to the terms + "H" : "Funext" + "(C ^op * D)%category" : "PreCategory" + "set_cat" : "PreCategory" + "hom_functor D o (F ^op, 1)" : "Functor (C ^op * D) set_cat" + "hom_functor C o (1, G)" : "Functor (C ^op * D) set_cat" +The 5th term has type "Functor (C ^op * D) set_cat" +which should be coercible to "object (C ^op * D -> set_cat)". +*) +End Core. + +End HoTT. + +End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core. diff --git a/test-suite/bugs/closed/bug_3331.v b/test-suite/bugs/closed/bug_3331.v new file mode 100644 index 0000000000..8594e45504 --- /dev/null +++ b/test-suite/bugs/closed/bug_3331.v @@ -0,0 +1,31 @@ +(* File reduced by coq-bug-finder from original input, then from 6303 lines to 66 lines, then from 63 lines to 36 lines *) +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y :> A" := (@paths A x y) : type_scope. +Arguments idpath {A a} , [A] a. +Notation "x = y" := (x = y :>_) : type_scope. +Class Contr_internal (A : Type) := BuildContr { center : A ; contr : (forall y : A, center = y) }. +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. +Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. +Instance istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) : IsTrunc n (x = y) := H x y. +Notation Contr := (IsTrunc minus_two). +Section groupoid_category. + Variable X : Type. + Context `{H : IsTrunc (trunc_S (trunc_S (trunc_S minus_two))) X}. + Goal X -> True. + intro d. + pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))) as H'. (* success *) + clear H'. + compute in H. + change (forall (x y : X) (p q : x = y) (r s : p = q), Contr (r = s)) in H. + assert (H' := H). + set (foo:=_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). (* success *) + clear H' foo. + Set Typeclasses Debug. + pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). +Abort. diff --git a/test-suite/bugs/closed/bug_3332.v b/test-suite/bugs/closed/bug_3332.v new file mode 100644 index 0000000000..a3564bfcce --- /dev/null +++ b/test-suite/bugs/closed/bug_3332.v @@ -0,0 +1,6 @@ +(* -*- coq-prog-args: ("-time") -*- *) +Definition foo : True. +Proof. +Abort. (* Toplevel input, characters 15-21: +Anomaly: Backtrack.backto to a state with no vcs_backup. Please report. *) +(* Anomaly: VernacAbort not handled by Stm. Please report. *) diff --git a/test-suite/bugs/closed/bug_3336.v b/test-suite/bugs/closed/bug_3336.v new file mode 100644 index 0000000000..dc358c6004 --- /dev/null +++ b/test-suite/bugs/closed/bug_3336.v @@ -0,0 +1,9 @@ +Require Import Setoid. + +Goal forall x y : Type, x = y -> x = y. +intros x y H. +setoid_rewrite H. +reflexivity. +Defined. +(* Toplevel input, characters 0-16: +Anomaly: Uncaught exception Reduction.NotConvertible(_). Please report. *) diff --git a/test-suite/bugs/closed/bug_3337.v b/test-suite/bugs/closed/bug_3337.v new file mode 100644 index 0000000000..cd7891f112 --- /dev/null +++ b/test-suite/bugs/closed/bug_3337.v @@ -0,0 +1,4 @@ +Require Import Setoid. +Goal forall x y : Set, x = y -> x = y. +intros x y H. +rewrite_strat subterms H. diff --git a/test-suite/bugs/closed/bug_3338.v b/test-suite/bugs/closed/bug_3338.v new file mode 100644 index 0000000000..076cd5e6ea --- /dev/null +++ b/test-suite/bugs/closed/bug_3338.v @@ -0,0 +1,4 @@ +Require Import Setoid. +Goal forall x y : Set, x = y -> y = y. +intros x y H. +rewrite_strat try topdown terms H. diff --git a/test-suite/bugs/closed/bug_3344.v b/test-suite/bugs/closed/bug_3344.v new file mode 100644 index 0000000000..880851c565 --- /dev/null +++ b/test-suite/bugs/closed/bug_3344.v @@ -0,0 +1,59 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 716 lines to 197 lines, then from 206 lines to 162 lines, then from 163 lines to 73 lines *) +Require Import Coq.Sets.Ensembles. +Require Import Coq.Strings.String. +Global Set Implicit Arguments. +Global Set Asymmetric Patterns. +Ltac clearbodies := repeat match goal with | [ H := _ |- _ ] => clearbody H end. + +Inductive Comp : Type -> Type := +| Return : forall A, A -> Comp A +| Bind : forall A B, Comp A -> (A -> Comp B) -> Comp B. +Inductive computes_to : forall A, Comp A -> A -> Prop := +| ReturnComputes : forall A v, @computes_to A (Return v) v +| BindComputes : forall A B comp_a f comp_a_value comp_b_value, + @computes_to A comp_a comp_a_value + -> @computes_to B (f comp_a_value) comp_b_value + -> @computes_to B (Bind comp_a f) comp_b_value. + +Inductive is_computational : forall A, Comp A -> Prop := +| Return_is_computational : forall A (x : A), is_computational (Return x) +| Bind_is_computational : forall A B (cA : Comp A) (f : A -> Comp B), + is_computational cA + -> (forall a, + @computes_to _ cA a -> is_computational (f a)) + -> is_computational (Bind cA f). +Theorem is_computational_inv A (c : Comp A) +: is_computational c + -> match c with + | Return _ _ => True + | Bind _ _ x f => is_computational x + /\ forall v, computes_to x v + -> is_computational (f v) + end. + admit. +Defined. +Fixpoint is_computational_unique_val A (c : Comp A) {struct c} +: is_computational c -> { a | unique (computes_to c) a }. +Proof. + refine match c as c return is_computational c -> { a | unique (computes_to c) a } with + | Return T x => fun _ => exist (unique (computes_to (Return x))) + x + _ + | Bind _ _ x f + => fun H + => let H' := is_computational_inv H in + let xv := @is_computational_unique_val _ _ (proj1 H') in + let fxv := @is_computational_unique_val _ _ (proj2 H' _ (proj1 (proj2_sig xv))) in + exist (unique (computes_to _)) + (proj1_sig fxv) + _ + end; + clearbodies; + clear is_computational_unique_val; + clear; + first [ abstract admit + | abstract admit ]. +(* [Fail] does not catch the anomaly *) +Defined. +(* Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/bug_3346.v b/test-suite/bugs/closed/bug_3346.v new file mode 100644 index 0000000000..09bd789345 --- /dev/null +++ b/test-suite/bugs/closed/bug_3346.v @@ -0,0 +1,4 @@ +(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) +Monomorphic Inductive paths (A : Type) (a : A) : A -> Type := idpath : paths A a a. +(* This should fail with -indices-matter *) +Fail Check paths nat O O : Prop. diff --git a/test-suite/bugs/closed/bug_3347.v b/test-suite/bugs/closed/bug_3347.v new file mode 100644 index 0000000000..dcf5394eaf --- /dev/null +++ b/test-suite/bugs/closed/bug_3347.v @@ -0,0 +1,40 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 12653 lines to 12453 lines, then from 11673 lines to 681 lines, then from 693 lines to 469 lines, then from 375 lines to 56 lines *) +Set Universe Polymorphism. +Notation Type1 := ltac:(let U := constr:(Type) in let gt := constr:(Set : U) in exact U) (only parsing). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Inductive Unit : Type1 := tt : Unit. +Fail Check Unit : Set. (* [Check Unit : Set] should fail if [Type1] is defined correctly *) +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Record Functor (C D : PreCategory) := { object_of :> C -> D }. +Definition indiscrete_category X : PreCategory := @Build_PreCategory X (fun _ _ => Unit). +Definition from_terminal (C : PreCategory) one (c : C) := Build_Functor one C (fun _ => c). +Local Notation "! x" := (from_terminal _ (indiscrete_category Unit) x) (at level 3). +Record NaturalTransformation {C D} (F G : Functor C D) := + { components_of :> forall c, morphism D (F c) (G c); + commutes : forall c, components_of c = components_of c }. +Definition slice_category_induced_functor_nt (D : PreCategory) s d (m : morphism D s d) +: NaturalTransformation !s !d. +Proof. + exists (fun _ : Unit => m); + simpl; intros; clear; + abstract admit. +Defined. +(* Toplevel input, characters 15-23: +Error: Illegal application: +The term "Build_NaturalTransformation" of type + "forall (C D : PreCategory) (F G : Functor C D) + (components_of : forall c : C, morphism D (F c) (G c)), + (forall c : C, components_of c = components_of c) -> + NaturalTransformation F G" +cannot be applied to the terms + "indiscrete_category Unit" : "PreCategory" + "D" : "PreCategory" + "! s" : "Functor (indiscrete_category Unit) D" + "! d" : "Functor (indiscrete_category Unit) D" + "fun _ : Unit => m" : "Unit -> morphism D s d" + "fun _ : Unit => slice_category_induced_functor_nt_subproof D s d m" + : "forall c : indiscrete_category Unit, m = m" +The 5th term has type "Unit -> morphism D s d" which should be coercible to + "forall c : indiscrete_category Unit, morphism D (! s c) (! d c)". + *) diff --git a/test-suite/bugs/closed/bug_3348.v b/test-suite/bugs/closed/bug_3348.v new file mode 100644 index 0000000000..904de68964 --- /dev/null +++ b/test-suite/bugs/closed/bug_3348.v @@ -0,0 +1,6 @@ +(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) +Set Universe Polymorphism. +Set Printing Universes. +Inductive Empty : Set := . +(* Toplevel input, characters 15-41: +Error: Universe inconsistency. Cannot enforce Prop <= Set). *) diff --git a/test-suite/bugs/closed/bug_3350.v b/test-suite/bugs/closed/bug_3350.v new file mode 100644 index 0000000000..c1ff292b3e --- /dev/null +++ b/test-suite/bugs/closed/bug_3350.v @@ -0,0 +1,121 @@ +Require Import TestSuite.admit. +Require Coq.Vectors.Fin. +Require Coq.Vectors.Vector. + +Local Generalizable All Variables. +Set Implicit Arguments. + +Arguments Fin.F1 : clear implicits. + +Lemma fin_0_absurd : notT (Fin.t 0). +Proof. hnf. apply Fin.case0. Qed. + +Axiom admit : forall {A}, A. + +Fixpoint lower {n:nat} (p:Fin.t (S n)) {struct p} : + forall (i:Fin.t (S n)), option (Fin.t n) + := match p in Fin.t (S n1) + return Fin.t (S n1) -> option (Fin.t n1) + with + | @Fin.F1 n1 => + fun (i:Fin.t (S n1)) => + match i in Fin.t (S n2) return option (Fin.t n2) with + | @Fin.F1 n2 => None + | @Fin.FS n2 i2 => Some i2 + end + | @Fin.FS n1 p1 => + fun (i:Fin.t (S n1)) => + match i in Fin.t (S n2) return Fin.t n2 -> option (Fin.t n2) with + | @Fin.F1 n2 => + match n2 as n3 return Fin.t n3 -> option (Fin.t n3) with + | 0 => fun p2 => False_rect _ (fin_0_absurd p2) + | S n3 => fun p2 => Some (Fin.F1 n3) + end + | @Fin.FS n2 i2 => + match n2 as n3 return Fin.t n3 -> Fin.t n3 -> option (Fin.t n3) with + | 0 => fun i3 p3 => False_rect _ (fin_0_absurd p3) + | S n3 => fun (i3 p3:Fin.t (S n3)) => + option_map (@Fin.FS _) admit + end i2 + end p1 + end. + +Lemma lower_ind (P: forall n (p i:Fin.t (S n)), option (Fin.t n) -> Prop) + (c11 : forall n, P n (Fin.F1 n) (Fin.F1 n) None) + (c1S : forall n (i:Fin.t n), P n (Fin.F1 n) (Fin.FS i) (Some i)) + (cS1 : forall n (p:Fin.t (S n)), + P (S n) (Fin.FS p) (Fin.F1 (S n)) (Some (Fin.F1 n))) + (cSSS : forall n (p i:Fin.t (S n)) (i':Fin.t n) + (Elow:lower p i = Some i'), + P n p i (Some i') -> + P (S n) (Fin.FS p) (Fin.FS i) (Some (Fin.FS i'))) + (cSSN : forall n (p i:Fin.t (S n)) + (Elow:lower p i = None), + P n p i None -> + P (S n) (Fin.FS p) (Fin.FS i) None) : + forall n (p i:Fin.t (S n)), P n p i (lower p i). +Proof. + fix lower_ind 2. intros n p. + refine (match p as p1 in Fin.t (S n1) + return forall (i1:Fin.t (S n1)), P n1 p1 i1 (lower p1 i1) + with + | @Fin.F1 n1 => _ + | @Fin.FS n1 p1 => _ + end); clear n p. + { revert n1. refine (@Fin.caseS _ _ _); cbn; intros. + apply c11. apply c1S. } + { intros i1. revert p1. + pattern n1, i1; refine (@Fin.caseS _ _ _ _ _); + clear n1 i1; + (intros [|n] i; [refine (False_rect _ (fin_0_absurd i)) | cbn ]). + { apply cS1. } + { intros p. pose proof (admit : P n p i (lower p i)) as H. + destruct (lower p i) eqn:E. + { admit; assumption. } + { cbn. apply admit; assumption. } } } +Qed. + +Section squeeze. + Context {A:Type} (x:A). + Notation vec := (Vector.t A). + + Fixpoint squeeze {n} (v:vec n) (i:Fin.t (S n)) {struct i} : vec (S n) := + match i in Fin.t (S _n) return vec _n -> vec (S _n) + with + | @Fin.F1 n' => fun v' => Vector.cons _ x _ v' + | @Fin.FS n' i' => + fun v' => + match n' as _n return vec _n -> Fin.t _n -> vec (S _n) + with + | 0 => fun u i' => False_rect _ (fin_0_absurd i') + | S m => + fun (u:vec (S m)) => + match u in Vector.t _ (S _m) + return Fin.t (S _m) -> vec (S (S _m)) + with + | Vector.nil _ => tt + | Vector.cons _ h _ u' => + fun j' => Vector.cons _ h _ admit (* (squeeze u' j') *) + end + end v' i' + end v. +End squeeze. + +Require Import Program. +Lemma squeeze_nth (A:Type) (x:A) (n:nat) (v:Vector.t A n) p i : + Vector.nth (squeeze x v p) i = match lower p i with + | Some j => Vector.nth v j + | None => x + end. +Proof. + (* alternatively: [functional induction (lower p i) using lower_ind] *) + revert v. pattern n, p, i, (lower p i). + refine (@lower_ind _ _ _ _ _ _ n p i); + intros; cbn; auto. + + (*** Fails here with "Conversion test raised an anomaly" ***) + revert v. + admit. + admit. + admit. +Qed. diff --git a/test-suite/bugs/closed/bug_3352.v b/test-suite/bugs/closed/bug_3352.v new file mode 100644 index 0000000000..bf2f7a9d19 --- /dev/null +++ b/test-suite/bugs/closed/bug_3352.v @@ -0,0 +1,35 @@ +Unset Strict Universe Declaration. + +(* +I'm not sure what the general rule should be; intuitively, I want [IsHProp (* Set *) Foo] to mean [IsHProp (* U >= Set *) Foo]. (I think this worked in HoTT/coq, too.) Morally, [IsHProp] has no universe level associated with it distinct from that of its argument, you should never get a universe inconsistency from unifying [IsHProp A] with [IsHProp A]. (The issue is tricker when IsHProp uses [A] elsewhere, as in: +*) + +(* File reduced by coq-bug-finder from original input, then from 7725 lines to 78 lines, then from 51 lines to 13 lines *) +Set Universe Polymorphism. +Inductive Empty : Set := . +Record IsHProp (A : Type) := { foo : True }. +Definition hprop_Empty : IsHProp@{i} Empty := {| foo := I |}. +Goal let U := Type in let gt := Set : U in IsHProp (Empty : U). +simpl. +Set Printing Universes. +exact @hprop_Empty. (* Toplevel input, characters 21-32: +Error: +The term "hprop_Empty" has type "IsHProp (* Set *) Empty" +while it is expected to have type "IsHProp (* Top.17 *) Empty" +(Universe inconsistency: Cannot enforce Top.17 = Set because Set < Top.17)). *) +Defined. + +Module B. +(* -*- coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 7725 lines to 78 lines, then from 51 lines to 13 lines *) +Set Universe Polymorphism. +Inductive paths {A} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Record Contr (A : Type) := { center : A }. +Monomorphic Record IsHProp (A : Type) := { foo : forall x y : A, Contr (x = y) }. +Definition hprop_Empty : IsHProp Empty := {| foo x y := match x : Empty with end |}. +Goal let U := Type in let gt := Set : U in IsHProp (Empty : U). +simpl. +Set Printing Universes. +exact hprop_Empty. +Defined. +End B. diff --git a/test-suite/bugs/closed/bug_3354.v b/test-suite/bugs/closed/bug_3354.v new file mode 100644 index 0000000000..a635285f2c --- /dev/null +++ b/test-suite/bugs/closed/bug_3354.v @@ -0,0 +1,12 @@ +Set Universe Polymorphism. +Notation Type1 := ltac:(let U := constr:(Type) in let gt := constr:(Set : U) in exact U) (only parsing). +Inductive Empty : Type1 := . +Fail Check Empty : Set. +(* Toplevel input, characters 15-116: +Error: Conversion test raised an anomaly *) +(* Now we make sure it's not an anomaly *) +Goal True. +Proof. + try exact (let x := Empty : Set in I). + exact I. +Defined. diff --git a/test-suite/bugs/closed/bug_3355.v b/test-suite/bugs/closed/bug_3355.v new file mode 100644 index 0000000000..46a5714781 --- /dev/null +++ b/test-suite/bugs/closed/bug_3355.v @@ -0,0 +1,6 @@ +Inductive paths {A} (x : A) : A -> Type := idpath : paths x x. +Goal forall A B : Set, @paths Type A B -> @paths Set A B. +Proof. + intros A B H. + Fail exact H. +Abort. diff --git a/test-suite/bugs/closed/bug_3368.v b/test-suite/bugs/closed/bug_3368.v new file mode 100644 index 0000000000..e22b4118c8 --- /dev/null +++ b/test-suite/bugs/closed/bug_3368.v @@ -0,0 +1,16 @@ +(* File reduced by coq-bug-finder from 7411 lines to 2271 lines., then from 889 lines to 119 lines, then from 76 lines to 19 lines *) +Set Universe Polymorphism. +Set Implicit Arguments. +Set Primitive Projections. +Record PreCategory := { object :> Type; morphism : object -> object -> Type }. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. +Definition opposite (C : PreCategory) : PreCategory := @Build_PreCategory C (fun s d => morphism C d s). +Definition opposite' C D (F : Functor C D) + := Build_Functor (opposite C) (opposite D) + (object_of F) + (fun s d => @morphism_of C D F d s). +(* Toplevel input, characters 15-191: +Anomaly: File "pretyping/reductionops.ml", line 149, characters 4-10: Assertion failed. +Please report. *) diff --git a/test-suite/bugs/closed/bug_3372.v b/test-suite/bugs/closed/bug_3372.v new file mode 100644 index 0000000000..91e3df76dd --- /dev/null +++ b/test-suite/bugs/closed/bug_3372.v @@ -0,0 +1,7 @@ +Set Universe Polymorphism. +Definition hProp : Type := sigT (fun _ : Type => True). +Goal Type. +Fail exact hProp@{Set}. (* test that it fails, but is not an anomaly *) +try (exact hProp@{Set}; fail 1). (* Toplevel input, characters 15-32: +Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). +Please report. *) diff --git a/test-suite/bugs/closed/bug_3373.v b/test-suite/bugs/closed/bug_3373.v new file mode 100644 index 0000000000..051e695203 --- /dev/null +++ b/test-suite/bugs/closed/bug_3373.v @@ -0,0 +1,34 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 5968 lines to +11933 lines, then from 11239 lines to 11231 lines, then from 10365 lines to 446 +lines, then from 456 lines to 379 lines, then from 391 lines to 373 lines, then +from 369 lines to 351 lines, then from 350 lines to 340 lines, then from 348 +lines to 320 lines, then from 328 lines to 302 lines, then from 332 lines to 21 +lines *) +Set Universe Polymorphism. +Module short. + Record foo := { bar : Type }. + Coercion baz (x : foo@{Set}) : Set := bar x. + Goal True. + Proof. + Fail pose ({| bar := Set |} : Type). (* check that it fails *) + try pose ({| bar := Set |} : Type). (* Anomaly: apply_coercion_args: mismatch between arguments and coercion. +Please report. *) + Admitted. +End short. + +Module long. + Axiom admit : forall {T}, T. + Definition UU := Set. + Definition UU' := Type. + Definition hSet:= sigT (fun X : UU' => admit) . + Definition pr1hSet:= @projT1 UU (fun X : UU' => admit) : hSet -> Type. + Coercion pr1hSet: hSet >-> Sortclass. + Axiom binop : UU -> Type. + Axiom setwithbinop : Type. + Goal True. + Proof. + Fail pose (( @projT1 _ ( fun X : hSet@{i j k} => binop X ) ) : _ -> hSet). (* check that it fails *) + try pose (( @projT1 _ ( fun X : hSet@{i j k} => binop X ) ) : _ -> hSet). (* check that it's not an anomaly *) + Admitted. +End long. diff --git a/test-suite/bugs/closed/bug_3374.v b/test-suite/bugs/closed/bug_3374.v new file mode 100644 index 0000000000..d8e72f4f20 --- /dev/null +++ b/test-suite/bugs/closed/bug_3374.v @@ -0,0 +1,52 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 5968 lines to 11933 lines, then from 11239 lines to 11231 lines, then from 10365 lines to 446 lines, then from 456 lines to 379 lines, then from 391 lines to 373 lines, then from 369 lines to 351 lines, then from 350 lines to 340 lines, then from 348 lines to 320 lines, then from 328 lines to 302 lines, then from 331 lines to 59 lines *) + +Set Universe Polymorphism. +Axiom admit : forall {T}, T. +Notation paths := identity . +Definition UU := Set. +Definition dirprod ( X Y : UU ) := sigT ( fun x : X => Y ) . +Definition dirprodpair { X Y : UU } := existT ( fun x : X => Y ) . +Definition hProp := sigT (fun X : Type => admit). +Definition hProptoType := @projT1 _ _ : hProp -> Type . +Coercion hProptoType: hProp >-> Sortclass. +Definition UU' := Type. +Definition hSet:= sigT (fun X : UU' => admit) . +Definition pr1hSet:= @projT1 UU (fun X : UU' => admit) : hSet -> Type. +Coercion pr1hSet: hSet >-> Sortclass. +Axiom hsubtypes : UU -> Type. +Definition hrel ( X : UU ) := X -> X -> hProp. +Axiom hreldirprod : forall { X Y : UU } ( RX : hrel X ) ( RY : hrel Y ), hrel ( dirprod X Y ) . +Axiom iseqclass : forall { X : UU } ( R : hrel X ) ( A : hsubtypes X ), Type. +Definition setquot { X : UU } ( R : hrel X ) : Type := sigT (fun A => iseqclass R A). +Axiom dirprodtosetquot : forall { X Y : UU } ( RX : hrel X ) ( RY : hrel Y ) (cd : dirprod ( setquot RX ) ( setquot RY ) ), + setquot ( hreldirprod RX RY ). +Definition iscomprelfun2 { X Y : UU } ( R : hrel X ) ( f : X -> X -> Y ) + := forall x x' x0 x0' : X , R x x' -> R x0 x0' -> paths ( f x x0 ) ( f x' x0' ) . +Axiom setquotuniv : forall { X : UU } ( R : hrel X ) ( Y : hSet ) ( f : X -> Y ) ( c : setquot R ), Y . +Definition setquotuniv2 { X : UU } ( R : hrel X ) ( Y : hSet ) ( f : X -> X -> Y ) ( is : iscomprelfun2 R f ) ( c c0 : setquot R ) +: Y . +Proof. + intros . + set ( RR := hreldirprod R R ) . + apply (setquotuniv RR Y admit). + apply (dirprodtosetquot R R). + apply dirprodpair; [ exact c | exact c0 ]. + Undo. + exact (dirprodpair c c0). +Defined. + (* Toplevel input, characters 39-40: +Error: +In environment +X : UU +R : hrel X +Y : hSet +f : X -> X -> Y +is : iscomprelfun2 R f +c : setquot R +c0 : setquot R +RR := hreldirprod R R : hrel (dirprod X X) +The term "c" has type "setquot R" while it is expected to have type +"?42" (unable to find a well-typed instantiation for +"?42": cannot unify"Type" and "UU"). + *) diff --git a/test-suite/bugs/closed/bug_3375.v b/test-suite/bugs/closed/bug_3375.v new file mode 100644 index 0000000000..1e0c8e61f4 --- /dev/null +++ b/test-suite/bugs/closed/bug_3375.v @@ -0,0 +1,49 @@ +Require Import TestSuite.admit. +(* -*- mode: coq; coq-prog-args: ("-impredicative-set") -*- *) +(* File reduced by coq-bug-finder from original input, then from 5968 lines to 11933 lines, then from 11239 lines to 11231 lines, then from 10365 lines to 446 lines, then from 456 lines to 379 lines, then from 391 lines to 373 lines, then from 369 lines to 351 lines, then from 350 lines to 340 lines, then from 348 lines to 320 lines, then from 328 lines to 302 lines, then from 330 lines to 45 lines *) + +Set Universe Polymorphism. +Axiom admit : forall {T}, T. +Definition UU := Set. +Definition dirprod ( X Y : UU ) := sigT ( fun x : X => Y ) . +Definition dirprodpair { X Y : UU } := existT ( fun x : X => Y ) . +Definition hProp := sigT (fun X : Type => admit). +Axiom hProppair : forall ( X : UU ) ( is : admit ), hProp. +Definition hProptoType := @projT1 _ _ : hProp -> Type . +Coercion hProptoType: hProp >-> Sortclass. +Definition ishinh_UU ( X : UU ) : UU := forall P: Set, ( ( X -> P ) -> P ). +Definition ishinh ( X : UU ) : hProp := hProppair ( ishinh_UU X ) admit. +Definition hsubtypes ( X : UU ) : Type := X -> hProp. +Axiom carrier : forall { X : UU } ( A : hsubtypes X ), Type. +Definition hrel ( X : UU ) : Type := X -> X -> hProp. +Set Printing Universes. +Definition iseqclass { X : UU } ( R : hrel X ) ( A : hsubtypes X ) : Type. + intros; exact ( dirprod ( ishinh ( carrier A ) ) ( dirprod ( forall x1 x2 : X , R x1 x2 -> A x1 -> A x2 ) + ( forall x1 x2 : X, A x1 -> A x2 -> R x1 x2 ) )) . +Defined. +Definition iseqclassconstr' { X : UU } ( R : hrel X ) { A : hsubtypes X } ( ax0 : ishinh ( carrier A ) ) + ( ax1 : forall x1 x2 : X , R x1 x2 -> A x1 -> A x2 ) ( ax2 : forall x1 x2 : X, A x1 -> A x2 -> R x1 x2 ) : iseqclass R A. + intros. + apply dirprodpair. { exact ax0. } + apply dirprodpair. { exact ax1. } {exact ax2. } +Defined. +Definition iseqclassconstr { X : UU } ( R : hrel X ) { A : hsubtypes X } ( ax0 : ishinh ( carrier A ) ) + ( ax1 : forall x1 x2 : X , R x1 x2 -> A x1 -> A x2 ) ( ax2 : forall x1 x2 : X, A x1 -> A x2 -> R x1 x2 ) : iseqclass R A. + pose @iseqclassconstr'. + intros. + exact (dirprodpair ax0 (dirprodpair ax1 ax2)). +Defined. +(* Toplevel input, characters 15-23: +Error: Illegal application: +The term "dirprodpair" of type + "forall (X Y : UU) (x : X), (fun _ : X => Y) x -> {_ : X & Y}" +cannot be applied to the terms + "forall x1 x2 : X, R x1 x2 -> A x1 -> A x2" + : "Type@{max(Set, Top.476, Top.479)}" + "forall x1 x2 : X, A x1 -> A x2 -> R x1 x2" + : "Type@{max(Set, Top.476, Top.479)}" + "ax1" : "forall x1 x2 : X, R x1 x2 -> A x1 -> A x2" + "ax2" : "forall x1 x2 : X, A x1 -> A x2 -> R x1 x2" +The 1st term has type "Type@{max(Set, Top.476, Top.479)}" +which should be coercible to "UU". + *) diff --git a/test-suite/bugs/closed/bug_3377.v b/test-suite/bugs/closed/bug_3377.v new file mode 100644 index 0000000000..abfcf1d355 --- /dev/null +++ b/test-suite/bugs/closed/bug_3377.v @@ -0,0 +1,18 @@ +Set Primitive Projections. +Set Implicit Arguments. +Record prod A B := pair { fst : A; snd : B}. + +Goal fst (@pair Type Type Type Type). +Set Printing All. +match goal with |- ?f ?x => set (foo := f x) end. +Abort. + +Goal forall x : prod Set Set, x = @pair _ _ (fst x) (snd x). +Proof. + intro x. + lazymatch goal with + | [ |- ?x = @pair _ _ (?f ?x) (?g ?x) ] => pose f + end. +(* Toplevel input, characters 7-44: +Error: No matching clauses for match. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3382.v b/test-suite/bugs/closed/bug_3382.v new file mode 100644 index 0000000000..3e374d9077 --- /dev/null +++ b/test-suite/bugs/closed/bug_3382.v @@ -0,0 +1,64 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from 9039 lines to 7786 lines, then from 7245 lines to 476 lines, then from 417 lines to 249 lines, then from 171 lines to 127 lines, then from 139 lines to 114 lines, then from 93 lines to 77 lines *) + +Set Implicit Arguments. +Definition admit {T} : T. +Admitted. +Delimit Scope object_scope with object. +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope functor_scope with functor. +Reserved Infix "o" (at level 40, left associativity). +Record PreCategory := + { Object :> Type; + Morphism : Object -> Object -> Type; + Compose : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' where "f 'o' g" := (Compose f g) }. +Bind Scope category_scope with PreCategory. +Infix "o" := (@Compose _ _ _ _) : morphism_scope. +Local Open Scope morphism_scope. +Record Functor (C D : PreCategory) := + { ObjectOf :> C -> D; + MorphismOf : forall s d, C.(Morphism) s d -> D.(Morphism) (ObjectOf s) (ObjectOf d); + FCompositionOf : forall s d d' (m1 : C.(Morphism) s d) (m2: C.(Morphism) d d'), + MorphismOf _ _ (m2 o m1) = (MorphismOf _ _ m2) o (MorphismOf _ _ m1) }. +Bind Scope functor_scope with Functor. +Arguments MorphismOf [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. +Definition ComposeFunctors C D E + (G : Functor D E) (F : Functor C D) : Functor C E + := Build_Functor C E (fun c => G (F c)) admit admit. +Infix "o" := ComposeFunctors : functor_scope. +Record NaturalTransformation C D (F G : Functor C D) := + { ComponentsOf :> forall c, D.(Morphism) (F c) (G c); + Commutes : forall s d (m : C.(Morphism) s d), + ComponentsOf d o F.(MorphismOf) m = G.(MorphismOf) m o ComponentsOf s }. +Definition NTComposeT C D (F F' F'' : Functor C D) + (T' : NaturalTransformation F' F'') + (T : NaturalTransformation F F') + (CO := fun c => T' c o T c) +: NaturalTransformation F F''. + exact (Build_NaturalTransformation F F'' + (fun c => T' c o T c) + (admit : forall s d (m : Morphism C s d), CO d o MorphismOf F m = MorphismOf F'' m o CO s)). +Defined. +Definition NTWhiskerR C D E (F F' : Functor D E) (T : NaturalTransformation F F') + (G : Functor C D) + := Build_NaturalTransformation (F o G) (F' o G) (fun c => T (G c)) admit. +Axiom NTWhiskerR_CompositionOf +: forall C D + (F G H : Functor C D) + (T : NaturalTransformation G H) + (T' : NaturalTransformation F G) B (I : Functor B C), + NTComposeT (NTWhiskerR T I) (NTWhiskerR T' I) = NTWhiskerR (NTComposeT T T') I. +Definition FunctorCategory C D : PreCategory + := @Build_PreCategory (Functor C D) + (NaturalTransformation (C := C) (D := D)) + admit. +Notation "[ C , D ]" := (FunctorCategory C D) : category_scope. +Class silly {T} := term : T. +Timeout 1 Fail Definition NTWhiskerR_Functorial (C D E : PreCategory) (G : [C, D]%category) +: [[D, E], [C, E]]%category + := Build_Functor + [C, D] [C, E] + (fun F => _ : silly) + (fun _ _ T => _ : silly) + (fun _ _ _ _ _ => NTWhiskerR_CompositionOf _ _ _). diff --git a/test-suite/bugs/closed/bug_3383.v b/test-suite/bugs/closed/bug_3383.v new file mode 100644 index 0000000000..25257644a6 --- /dev/null +++ b/test-suite/bugs/closed/bug_3383.v @@ -0,0 +1,6 @@ +Goal forall b : bool, match b as b' return if b' then True else True with true => I | false => I end = match b as b' return if b' then True else True with true => I | false => I end. +intro. +lazymatch goal with +| [ |- context[match ?b as b' in bool return @?P b' with true => ?t | false => ?f end] ] + => change (match b as b' in bool return P b' with true => t | false => f end) with (@bool_rect P t f b) +end. diff --git a/test-suite/bugs/closed/bug_3386.v b/test-suite/bugs/closed/bug_3386.v new file mode 100644 index 0000000000..b8bb8bce09 --- /dev/null +++ b/test-suite/bugs/closed/bug_3386.v @@ -0,0 +1,17 @@ +Unset Strict Universe Declaration. +Set Universe Polymorphism. +Set Printing Universes. +Record Cat := { Obj :> Type }. +Definition set_cat := {| Obj := Type |}. +Goal Type@{i} = Type@{j}. +Proof. + (* 1 subgoals +, subgoal 1 (ID 3) + + ============================ + Type@{Top.368} = Type@{Top.370} +(dependent evars:) *) + Fail change Type@{i} with (Obj set_cat@{i}). (* check that it fails *) + try change Type@{i} with (Obj set_cat@{i}). (* check that it's not an anomaly *) +(* Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). +Please report. *) diff --git a/test-suite/bugs/closed/bug_3387.v b/test-suite/bugs/closed/bug_3387.v new file mode 100644 index 0000000000..1d9e783374 --- /dev/null +++ b/test-suite/bugs/closed/bug_3387.v @@ -0,0 +1,22 @@ +Unset Strict Universe Declaration. +Set Universe Polymorphism. +Set Printing Universes. +Record Cat := { Obj :> Type }. +Definition set_cat := {| Obj := Type |}. +Goal Type@{i} = Type@{j}. +Proof. + (* 1 subgoals +, subgoal 1 (ID 3) + + ============================ + Type@{Top.368} = Type@{Top.370} +(dependent evars:) *) + let x := constr:(Type) in + let y := constr:(Obj set_cat) in + unify x y. (* success *) + let x := constr:(Type) in + let y := constr:(Obj set_cat) in + first [ unify x y | fail 2 "no unify" ]; + change x with y at -1. (* Error: Not convertible. *) + reflexivity. +Defined. diff --git a/test-suite/bugs/closed/bug_3388.v b/test-suite/bugs/closed/bug_3388.v new file mode 100644 index 0000000000..7826280498 --- /dev/null +++ b/test-suite/bugs/closed/bug_3388.v @@ -0,0 +1,57 @@ +Inductive test : bool -> bool -> Type := +| test00 : test false false +| test01 : test false true +| test10 : test true false +. + +(* This does not work *) +Definition test_a (t : test true false) : test true false := + match t with + | test10 => test10 + end. + +(* The following definition shows that test_a SHOULD work *) +Definition test_a_workaround (t : test true false) : test true false := + match t with + | test10 => test10 + | _ => tt + end. + +(* Surprisingly, this works *) +Definition test_b (t : test false true) : test false true := + match t with + | test01 => test01 + end. + + +(* This, too, works *) +Definition test_c x (t : test false x) : test false x := + match t with + | test00 => test00 + | test01 => test01 + end. + +Inductive test2 : bool -> bool -> Type := +| test201 : test2 false true +| test210 : test2 true false +| test211 : test2 true true +. + +(* Now this works *) +Definition test2_a (t : test2 true false) : test2 true false := + match t with + | test210 => test210 + end. + +(* Accordingly, this now fails *) +Definition test2_b (t : test2 false true) : test2 false true := + match t with + | test201 => test201 + end. + + +(* This, too, fails *) +Definition test2_c x (t : test2 false x) : test2 false x := + match t with + | test201 => test201 + end. diff --git a/test-suite/bugs/closed/bug_3390.v b/test-suite/bugs/closed/bug_3390.v new file mode 100644 index 0000000000..eb3c4f4b9c --- /dev/null +++ b/test-suite/bugs/closed/bug_3390.v @@ -0,0 +1,9 @@ +Tactic Notation "basicapply" open_constr(R) "using" tactic3(tac) "sideconditions" tactic0(tacfin) := idtac. +Tactic Notation "basicapply" open_constr(R) := basicapply R using (fun Hlem => idtac) sideconditions (autounfold with spred; idtac). +(* segfault in coqtop *) + + +Tactic Notation "basicapply" tactic0(tacfin) := idtac. + +Goal True. +basicapply subst. diff --git a/test-suite/bugs/closed/bug_3392.v b/test-suite/bugs/closed/bug_3392.v new file mode 100644 index 0000000000..a03db77544 --- /dev/null +++ b/test-suite/bugs/closed/bug_3392.v @@ -0,0 +1,40 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 12105 lines to 142 lines, then from 83 lines to 57 lines *) +Generalizable All Variables. +Axiom admit : forall {T}, T. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. +Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): transport _ p (f x) = f y := admit. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) }. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3). +Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), (forall x, f x = g x) -> f = g. +Axiom isequiv_adjointify : forall {A B} (f : A -> B) (g : B -> A) (isretr : Sect g f) (issect : Sect f g), IsEquiv f. +Definition functor_forall `{P : A -> Type} `{Q : B -> Type} (f0 : B -> A) (f1 : forall b:B, P (f0 b) -> Q b) +: (forall a:A, P a) -> (forall b:B, Q b) := (fun g b => f1 _ (g (f0 b))). +Goal forall `{P : A -> Type} `{Q : B -> Type} `{IsEquiv B A f} `{forall b, @IsEquiv (P (f b)) (Q b) (g b)}, + IsEquiv (functor_forall f g). +Proof. + intros. + refine (isequiv_adjointify (functor_forall f g) + (functor_forall (f^-1) + (fun (x:A) (y:Q (f^-1 x)) => @eisretr _ _ f H x # (g (f^-1 x))^-1 y + )) _ _); intros h. + - abstract ( + apply path_forall; intros b; unfold functor_forall; + rewrite eisadj; + admit + ). + - abstract ( + apply path_forall; intros a; unfold functor_forall; + rewrite eissect; + apply apD + ). +Defined. diff --git a/test-suite/bugs/closed/bug_3393.v b/test-suite/bugs/closed/bug_3393.v new file mode 100644 index 0000000000..ae8e41e29e --- /dev/null +++ b/test-suite/bugs/closed/bug_3393.v @@ -0,0 +1,153 @@ +Require Import TestSuite.admit. +(* -*- coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 8760 lines to 7519 lines, then from 7050 lines to 909 lines, then from 846 lines to 578 lines, then from 497 lines to 392 lines, then from 365 lines to 322 lines, then from 252 lines to 205 lines, then from 215 lines to 204 lines, then from 210 lines to 182 lines, then from 175 lines to 157 lines *) +Set Universe Polymorphism. +Axiom admit : forall {T}, T. +Set Implicit Arguments. +Generalizable All Variables. +Reserved Notation "g 'o' f" (at level 40, left associativity). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "a = b" := (@paths _ a b) : type_scope. +Arguments idpath {A a} , [A] a. +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) : forall x, f x = g x := fun x => match h with idpath => idpath end. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A }. +Delimit Scope equiv_scope with equiv. +Local Open Scope equiv_scope. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. +Class Funext := { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. +Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x) : (forall x, f x = g x) -> f = g := (@apD10 A P f g)^-1. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + compose : forall s d d', morphism d d' -> morphism s d -> morphism s d' where "f 'o' g" := (compose f g); + associativity : forall x1 x2 x3 x4 (m1 : morphism x1 x2) (m2 : morphism x2 x3) (m3 : morphism x3 x4), (m3 o m2) o m1 = m3 o (m2 o m1) + }. +Bind Scope category_scope with PreCategory. +Bind Scope morphism_scope with morphism. +Infix "o" := (@compose _ _ _ _) : morphism_scope. +Delimit Scope functor_scope with functor. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. +Bind Scope functor_scope with Functor. +Notation "F '_1' m" := (@morphism_of _ _ F _ _ m) (at level 10, no associativity) : morphism_scope. +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. +Local Notation "m ^-1" := (morphism_inverse (m := m)) : morphism_scope. +Class Isomorphic {C : PreCategory} s d := + { morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. +Coercion morphism_isomorphic : Isomorphic >-> morphism. +Definition isisomorphism_inverse `(@IsIsomorphism C x y m) : IsIsomorphism m^-1 := {| morphism_inverse := m |}. + +Global Instance isisomorphism_compose `(@IsIsomorphism C y z m0) `(@IsIsomorphism C x y m1) : IsIsomorphism (m0 o m1). +Admitted. +Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. +Definition composef C D E (G : Functor D E) (F : Functor C D) : Functor C E + := Build_Functor + C E + (fun c => G (F c)) + (fun _ _ m => @morphism_of _ _ G _ _ (@morphism_of _ _ F _ _ m)). +Infix "o" := composef : functor_scope. +Delimit Scope natural_transformation_scope with natural_transformation. + +Local Open Scope morphism_scope. +Record NaturalTransformation C D (F G : Functor C D) := + { components_of :> forall c, morphism D (F c) (G c); + commutes : forall s d (m : morphism C s d), components_of d o F _1 m = G _1 m o components_of s }. + +Definition composet C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F') +: NaturalTransformation F F'' + := Build_NaturalTransformation F F'' (fun c => T' c o T c) admit. +Infix "o" := composet : natural_transformation_scope. +Section path_natural_transformation. + Context `{Funext}. + Variable C : PreCategory. + Variable D : PreCategory. + Variables F G : Functor C D. + Section path. + Variables T U : NaturalTransformation F G. + Lemma path'_natural_transformation + : components_of T = components_of U + -> T = U. + admit. + Defined. + Lemma path_natural_transformation + : (forall x, components_of T x = components_of U x) + -> T = U. + Proof. + intros. + apply path'_natural_transformation. + apply path_forall; assumption. + Qed. + End path. +End path_natural_transformation. +Ltac path_natural_transformation := + repeat match goal with + | _ => intro + | _ => apply path_natural_transformation; simpl + end. + +Local Open Scope natural_transformation_scope. +Definition associativityt `{fs : Funext} + C D F G H I + (V : @NaturalTransformation C D F G) + (U : @NaturalTransformation C D G H) + (T : @NaturalTransformation C D H I) +: (T o U) o V = T o (U o V). +Proof. + path_natural_transformation. + apply associativity. +Qed. +Definition functor_category `{Funext} (C D : PreCategory) : PreCategory + := @Build_PreCategory (Functor C D) (@NaturalTransformation C D) (@composet C D) (@associativityt _ C D). +Notation "C -> D" := (functor_category C D) : category_scope. +Definition NaturalIsomorphism `{Funext} (C D : PreCategory) F G := @Isomorphic (C -> D) F G. +Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. +Global Instance isisomorphism_compose' `{Funext} + `(T' : @NaturalTransformation C D F' F'') + `(T : @NaturalTransformation C D F F') + `{@IsIsomorphism (C -> D) F' F'' T'} + `{@IsIsomorphism (C -> D) F F' T} +: @IsIsomorphism (C -> D) F F'' (T' o T)%natural_transformation + := @isisomorphism_compose (C -> D) _ _ T' _ _ T _. +Section lemmas. + Context `{Funext}. + Variable C : PreCategory. + Variable F : C -> PreCategory. + Context + {w y z} + {f : Functor (F w) (F z)} {f0 : Functor (F w) (F y)} + {f2 : Functor (F y) (F z)} + {f5 : Functor (F w) (F z)} + {n2 : f <~=~> (f2 o f0)%functor}. + Lemma p_composition_of_coherent_iso_for_rewrite__isisomorphism_helper' XX + : @IsIsomorphism + (F w -> F z) f5 f + (n2 ^-1 o XX)%natural_transformation. + Proof. + eapply isisomorphism_compose'. + eapply isisomorphism_inverse. (* Toplevel input, characters 22-43: +Error: +In environment +H : Funext +C : PreCategory +F : C -> PreCategory +w : C +y : C +z : C +f : Functor (F w) (F z) +f0 : Functor (F w) (F y) +f2 : Functor (F y) (F z) +f5 : Functor (F w) (F z) +n2 : f <~=~> (f2 o f0)%functor +XX : NaturalTransformation f5 (f2 o f0) +Unable to unify + "{| + object := Functor (F w) (F z); + morphism := NaturalTransformation (D:=F z); + compose := composet (D:=F z); + associativity := associativityt (D:=F z) |}" with + "{| + object := Functor (F w) (F z); + morphism := NaturalTransformation (D:=F z); + compose := composet (D:=F z); + associativity := associativityt (D:=F z) |}". *) diff --git a/test-suite/bugs/closed/bug_3402.v b/test-suite/bugs/closed/bug_3402.v new file mode 100644 index 0000000000..b4705780db --- /dev/null +++ b/test-suite/bugs/closed/bug_3402.v @@ -0,0 +1,7 @@ +Set Primitive Projections. +Record prod A B := pair { fst : A ; snd : B }. +Goal forall A B (p : prod A B), p = let (x, y) := p in pair A B x y. +Proof. + intros A B p. + exact eq_refl. +Qed. diff --git a/test-suite/bugs/closed/bug_3408.v b/test-suite/bugs/closed/bug_3408.v new file mode 100644 index 0000000000..62f5382bd1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3408.v @@ -0,0 +1,163 @@ +Require Import BinPos. + +Inductive expr : Type := + Var : nat -> expr +| App : expr -> expr -> expr +| Abs : unit -> expr -> expr. + +Inductive expr_acc +: expr -> expr -> Prop := + acc_App_l : forall f a : expr, + expr_acc f (App f a) +| acc_App_r : forall f a : expr, + expr_acc a (App f a) +| acc_Abs : forall (t : unit) (e : expr), + expr_acc e (Abs t e). + +Theorem wf_expr_acc : well_founded expr_acc. +Proof. + red. + refine (fix rec a : Acc expr_acc a := + match a as a return Acc expr_acc a with + | Var v => Acc_intro _ (fun y (_H : expr_acc y (Var v)) => + match _H in expr_acc z Z + return match Z return Prop with + | Var _ => Acc _ y + | _ => True + end + with + | acc_App_l _ _ => I + | _ => I + end) + | App f x => Acc_intro _ (fun y (pf : expr_acc y (App f x)) => + match pf in expr_acc z Z + return match Z return Prop with + | App a b => f = a -> x = b -> Acc expr_acc z + | _ => True + end + with + | acc_App_l f' x' => fun pf _ => match pf in _ = z return + Acc expr_acc z + with + | eq_refl => rec f + end + | acc_App_r f' x' => fun _ pf => match pf in _ = z return + Acc expr_acc z + with + | eq_refl => rec x + end + | _ => I + end eq_refl eq_refl) + | Abs t e => Acc_intro _ (fun y (pf : expr_acc y (Abs t e)) => + match pf in expr_acc z Z + return match Z return Prop with + | Abs a b => e = b -> Acc expr_acc z + | _ => True + end + with + | acc_Abs f x => fun pf => match pf in _ = z return + Acc expr_acc z + with + | eq_refl => rec e + end + | _ => I + end eq_refl) + end). +Defined. + +Theorem wf_expr_acc_delay : well_founded expr_acc. +Proof. + red. + refine (fix rec a : Acc expr_acc a := + match a as a return Acc expr_acc a with + | Var v => Acc_intro _ (fun y (_H : expr_acc y (Var v)) => + match _H in expr_acc z Z + return match Z return Prop with + | Var _ => Acc _ y + | _ => True + end + with + | acc_App_l _ _ => I + | _ => I + end) + | App f x => Acc_intro _ (fun y (pf : expr_acc y (App f x)) => + match pf in expr_acc z Z + return match Z return Prop with + | App a b => (unit -> Acc expr_acc a) -> (unit -> Acc expr_acc b) -> Acc expr_acc z + | _ => True + end + with + | acc_App_l f' x' => fun pf _ => pf tt + | acc_App_r f' x' => fun _ pf => pf tt + | _ => I + end (fun _ => rec f) (fun _ => rec x)) + | Abs t e => Acc_intro _ (fun y (pf : expr_acc y (Abs t e)) => + match pf in expr_acc z Z + return match Z return Prop with + | Abs a b => (unit -> Acc expr_acc b) -> Acc expr_acc z + | _ => True + end + with + | acc_Abs f x => fun pf => pf tt + | _ => I + end (fun _ => rec e)) + end); + try solve [ inversion _H ]. +Defined. + +Fixpoint build_large (n : nat) : expr := + match n with + | 0 => Var 0 + | S n => + let e := build_large n in + App e e + end. + +Section guard. + Context {A : Type} {R : A -> A -> Prop}. + + Fixpoint guard (n : nat) (wfR : well_founded R) : well_founded R := + match n with + | 0 => wfR + | S n0 => + fun x : A => + Acc_intro x + (fun (y : A) (_ : R y x) => guard n0 (guard n0 wfR) y) + end. +End guard. + + +Definition sizeF_delay : expr -> positive. +refine + (@Fix expr (expr_acc) + (wf_expr_acc_delay) + (fun _ => positive) + (fun e => + match e as e return (forall l, expr_acc l e -> positive) -> positive with + | Var _ => fun _ => 1 + | App l r => fun rec => @rec l _ + @rec r _ + | Abs _ e => fun rec => 1 + @rec e _ + end%positive)). +eapply acc_App_l. +eapply acc_App_r. +eapply acc_Abs. +Defined. + +Definition sizeF_guard : expr -> positive. +refine + (@Fix expr (expr_acc) + (guard 5 wf_expr_acc) + (fun _ => positive) + (fun e => + match e as e return (forall l, expr_acc l e -> positive) -> positive with + | Var _ => fun _ => 1 + | App l r => fun rec => @rec l _ + @rec r _ + | Abs _ e => fun rec => 1 + @rec e _ + end%positive)). +eapply acc_App_l. +eapply acc_App_r. +eapply acc_Abs. +Defined. + +Time Eval native_compute in sizeF_delay (build_large 2). +Time Eval native_compute in sizeF_guard (build_large 2). diff --git a/test-suite/bugs/closed/bug_3416.v b/test-suite/bugs/closed/bug_3416.v new file mode 100644 index 0000000000..5cfb8f1ff4 --- /dev/null +++ b/test-suite/bugs/closed/bug_3416.v @@ -0,0 +1,12 @@ +Inductive list A := Node : node A -> list A +with node A := Nil | Cons : A -> list A -> node A. + +Fixpoint app {A} (l1 l2 : list A) {struct l1} : list A +with app_node {A} (n1 : node A) (l2 : list A) {struct n1} : node A. +Proof. ++ destruct l1 as [n]; constructor. + exact (app_node _ n l2). ++ destruct n1 as [|x l1]. + - destruct l2 as [n2]; exact n2. + - exact (Cons _ x (app _ l1 l2)). +Qed. diff --git a/test-suite/bugs/closed/bug_3417.v b/test-suite/bugs/closed/bug_3417.v new file mode 100644 index 0000000000..9d7c6f013d --- /dev/null +++ b/test-suite/bugs/closed/bug_3417.v @@ -0,0 +1,7 @@ +Require Setoid. + +Goal forall {T}(a b : T), b=a -> {c | c=b}. +Proof. +intros T a b H. +try setoid_rewrite H. +Abort. diff --git a/test-suite/bugs/closed/bug_3422.v b/test-suite/bugs/closed/bug_3422.v new file mode 100644 index 0000000000..460ae8f110 --- /dev/null +++ b/test-suite/bugs/closed/bug_3422.v @@ -0,0 +1,209 @@ +Require Import TestSuite.admit. +Generalizable All Variables. +Set Implicit Arguments. +Set Universe Polymorphism. +Axiom admit : forall {T}, T. +Reserved Infix "o" (at level 40, left associativity). +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. +Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Existing Instance equiv_isequiv. +Delimit Scope equiv_scope with equiv. +Local Open Scope equiv_scope. +Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. +Axiom IsHSet : Type -> Type. +Existing Class IsHSet. +Definition trunc_equiv' `(f : A <~> B) `{IsHSet A} : IsHSet B := admit. +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g); + + trunc_morphism : forall s d, IsHSet (morphism s d) }. + +Bind Scope category_scope with PreCategory. +Infix "o" := (@compose _ _ _ _) : morphism_scope. + +Delimit Scope functor_scope with functor. + +Record Functor (C D : PreCategory) := + { + object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d) + }. + +Bind Scope functor_scope with Functor. +Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. +Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. +Local Open Scope morphism_scope. + +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. + +Local Notation "m ^-1" := (morphism_inverse (m := m)) : morphism_scope. + +Class Isomorphic {C : PreCategory} s d := + { + morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic + }. + +Coercion morphism_isomorphic : Isomorphic >-> morphism. + +Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. + +Definition isisomorphism_inverse `(@IsIsomorphism C x y m) : IsIsomorphism m^-1 := {| morphism_inverse := m |}. + +Global Instance isisomorphism_compose `(@IsIsomorphism C y z m0) `(@IsIsomorphism C x y m1) +: IsIsomorphism (m0 o m1). +admit. +Defined. + +Section composition. + Variable C : PreCategory. + Variable D : PreCategory. + Variable E : PreCategory. + Variable G : Functor D E. + Variable F : Functor C D. + + Definition composeF : Functor C E + := Build_Functor + C E + (fun c => G (F c)) + (fun _ _ m => morphism_of G (morphism_of F m)). +End composition. +Infix "o" := composeF : functor_scope. + +Delimit Scope natural_transformation_scope with natural_transformation. +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. + +Section compose. + Variable C : PreCategory. + Variable D : PreCategory. + Variables F F' F'' : Functor C D. + + Variable T' : NaturalTransformation F' F''. + Variable T : NaturalTransformation F F'. + + Local Notation CO c := (T' c o T c). + + Definition composeT + : NaturalTransformation F F'' := Build_NaturalTransformation F F'' (fun c => CO c). + +End compose. + +Section whisker. + Variable C : PreCategory. + Variable D : PreCategory. + Variable E : PreCategory. + + Section L. + Variable F : Functor D E. + Variables G G' : Functor C D. + Variable T : NaturalTransformation G G'. + + Local Notation CO c := (morphism_of F (T c)). + + Definition whisker_l + := Build_NaturalTransformation + (F o G) (F o G') + (fun c => CO c). + + End L. + + Section R. + Variables F F' : Functor D E. + Variable T : NaturalTransformation F F'. + Variable G : Functor C D. + + Local Notation CO c := (T (G c)). + + Definition whisker_r + := Build_NaturalTransformation + (F o G) (F' o G) + (fun c => CO c). + End R. +End whisker. +Infix "o" := composeT : natural_transformation_scope. +Infix "oL" := whisker_l (at level 40, left associativity) : natural_transformation_scope. +Infix "oR" := whisker_r (at level 40, left associativity) : natural_transformation_scope. + +Section path_natural_transformation. + + Variable C : PreCategory. + Variable D : PreCategory. + Variables F G : Functor C D. + + Lemma equiv_sig_natural_transformation + : { CO : forall x, morphism D (F x) (G x) + | forall s d (m : morphism C s d), + CO d o F _1 m = G _1 m o CO s } + <~> NaturalTransformation F G. + admit. + Defined. + + Global Instance trunc_natural_transformation + : IsHSet (NaturalTransformation F G). + Proof. + eapply trunc_equiv'; [ exact equiv_sig_natural_transformation | ]. + admit. + Qed. + +End path_natural_transformation. +Definition functor_category (C D : PreCategory) : PreCategory + := @Build_PreCategory (Functor C D) (@NaturalTransformation C D) (@composeT C D) _. + +Notation "C -> D" := (functor_category C D) : category_scope. + +Definition NaturalIsomorphism (C D : PreCategory) F G := @Isomorphic (C -> D) F G. + +Coercion natural_transformation_of_natural_isomorphism C D F G (T : @NaturalIsomorphism C D F G) : NaturalTransformation F G + := T : morphism _ _ _. +Local Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. +Global Instance isisomorphism_compose' + `(T' : @NaturalTransformation C D F' F'') + `(T : @NaturalTransformation C D F F') + `{@IsIsomorphism (C -> D) F' F'' T'} + `{@IsIsomorphism (C -> D) F F' T} +: @IsIsomorphism (C -> D) F F'' (T' o T)%natural_transformation + := @isisomorphism_compose (C -> D) _ _ T' _ _ T _. + +Section lemmas. + Local Open Scope natural_transformation_scope. + + Variable C : PreCategory. + Variable F : C -> PreCategory. + Context + {w x y z} + {f : Functor (F w) (F z)} {f0 : Functor (F w) (F y)} + {f1 : Functor (F x) (F y)} {f2 : Functor (F y) (F z)} + {f3 : Functor (F w) (F x)} {f4 : Functor (F x) (F z)} + {f5 : Functor (F w) (F z)} {n : f5 <~=~> (f4 o f3)%functor} + {n0 : f4 <~=~> (f2 o f1)%functor} {n1 : f0 <~=~> (f1 o f3)%functor} + {n2 : f <~=~> (f2 o f0)%functor}. + + Lemma p_composition_of_coherent_iso_for_rewrite__isisomorphism_helper' + : @IsIsomorphism + (_ -> _) _ _ + (n2 ^-1 o (f2 oL n1 ^-1 o (admit o (n0 oR f3 o n))))%natural_transformation. + Proof. + eapply isisomorphism_compose'; + [ eapply isisomorphism_inverse + | eapply isisomorphism_compose'; + [ admit + | eapply isisomorphism_compose'; + [ admit | + eapply isisomorphism_compose'; [ admit | ]]]]. + Set Printing All. Set Printing Universes. + apply @isisomorphism_isomorphic. + Qed. + +End lemmas. diff --git a/test-suite/bugs/closed/bug_3427.v b/test-suite/bugs/closed/bug_3427.v new file mode 100644 index 0000000000..9a57ca7703 --- /dev/null +++ b/test-suite/bugs/closed/bug_3427.v @@ -0,0 +1,196 @@ +Require Import TestSuite.admit. +(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 0 lines to 7171 lines, then from 7184 lines to 558 lines, then from 556 lines to 209 lines *) +Generalizable All Variables. +Set Universe Polymorphism. +Notation Type0 := Set. +Notation idmap := (fun x => x). +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. +Open Scope function_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Delimit Scope path_scope with path. +Local Open Scope path_scope. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. +Notation "1" := idpath : path_scope. +Notation "p @ q" := (concat p q) (at level 20) : path_scope. +Notation "p ^" := (inverse p) (at level 3) : path_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) := forall x:A, f x = g x. +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) : forall x, f x = g x := fun x => match h with idpath => idpath end. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) + }. +Record Equiv A B := BuildEquiv { + equiv_fun :> A -> B ; + equiv_isequiv :> IsEquiv equiv_fun + }. + +Delimit Scope equiv_scope with equiv. + +Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) + }. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Fixpoint nat_to_trunc_index (n : nat) : trunc_index + := match n with + | 0 => trunc_S (trunc_S minus_two) + | S n' => trunc_S (nat_to_trunc_index n') + end. + +Coercion nat_to_trunc_index : nat >-> trunc_index. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Notation minus_one:=(trunc_S minus_two). + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Notation Contr := (IsTrunc minus_two). +Notation IsHProp := (IsTrunc minus_one). +Notation IsHSet := (IsTrunc 0). + +Class Funext := + { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. + +Definition concat_pV {A : Type} {x y : A} (p : x = y) : + p @ p^ = 1 + := + match p with idpath => 1 end. + +Definition concat_Vp {A : Type} {x y : A} (p : x = y) : + p^ @ p = 1 + := + match p with idpath => 1 end. + +Definition transport_pp {A : Type} (P : A -> Type) {x y z : A} (p : x = y) (q : y = z) (u : P x) : + p @ q # u = q # p # u := + match q with idpath => + match p with idpath => 1 end + end. + +Definition transport2 {A : Type} (P : A -> Type) {x y : A} {p q : x = y} + (r : p = q) (z : P x) +: p # z = q # z + := ap (fun p' => p' # z) r. + +Inductive Unit : Type0 := + tt : Unit. + +Instance contr_unit : Contr Unit | 0 := let x := {| + center := tt; + contr := fun t : Unit => match t with tt => 1 end + |} in x. + +Instance trunc_succ `{IsTrunc n A} : IsTrunc (trunc_S n) A | 1000. +admit. +Defined. + +Record hProp := hp { hproptype :> Type ; isp : IsHProp hproptype}. +Definition Unit_hp:hProp:=(hp Unit _). + +Global Instance isequiv_ap_hproptype `{Funext} X Y : IsEquiv (@ap _ _ hproptype X Y). +admit. +Defined. + +Definition path_hprop `{Funext} X Y := (@ap _ _ hproptype X Y)^-1%equiv. + +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. +Local Open Scope equiv_scope. + +Instance isequiv_path {A B : Type} (p : A = B) +: IsEquiv (transport (fun X:Type => X) p) | 0 + := BuildIsEquiv _ _ _ (transport (fun X:Type => X) p^) + (fun b => ((transport_pp idmap p^ p b)^ @ transport2 idmap (concat_Vp p) b)) + (fun a => ((transport_pp idmap p p^ a)^ @ transport2 idmap (concat_pV p) a)) + (fun a => match p in _ = C return + (transport_pp idmap p^ p (transport idmap p a))^ @ + transport2 idmap (concat_Vp p) (transport idmap p a) = + ap (transport idmap p) ((transport_pp idmap p p^ a) ^ @ + transport2 idmap (concat_pV p) a) with idpath => 1 end). + +Definition equiv_path (A B : Type) (p : A = B) : A <~> B + := BuildEquiv _ _ (transport (fun X:Type => X) p) _. + +Class Univalence := { + isequiv_equiv_path :> forall (A B : Type), IsEquiv (equiv_path A B) + }. + +Section Univalence. + Context `{Univalence}. + + Definition path_universe_uncurried {A B : Type} (f : A <~> B) : A = B + := (equiv_path A B)^-1 f. +End Univalence. + +Local Inductive minus1Trunc (A :Type) : Type := + min1 : A -> minus1Trunc A. + +Instance minus1Trunc_is_prop {A : Type} : IsHProp (minus1Trunc A) | 0. +admit. +Defined. + +Definition hexists {X} (P:X->Type):Type:= minus1Trunc (sigT P). + +Section AssumingUA. + + Definition isepi {X Y} `(f:X->Y) := forall Z: hSet, + forall g h: Y -> Z, g o f = h o f -> g = h. + Context {X Y : hSet} (f : X -> Y) (Hisepi : isepi f). + + Goal forall (X Y : hSet) (f : forall _ : setT X, setT Y), + let fib := + fun y : setT Y => + hp (@hexists (setT X) (fun x : setT X => @paths (setT Y) (f x) y)) + (@minus1Trunc_is_prop + (@sigT (setT X) (fun x : setT X => @paths (setT Y) (f x) y))) in + forall (x : setT X) (_ : Univalence) (_ : Funext), + @paths hProp (fib (f x)) Unit_hp. + intros. + + apply path_hprop. + simpl. + Set Printing Universes. + Set Printing All. + refine (path_universe_uncurried _). + Undo. + apply path_universe_uncurried. (* Toplevel input, characters 21-44: +Error: Refiner was given an argument + "@path_universe_uncurried (* Top.425 Top.426 Top.427 Top.428 Top.429 *) X1 + (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) + (fun x0 : setT (* Top.405 *) X0 => + @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit + ?63" of type + "@paths (* Top.428 *) Type (* Top.425 *) + (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) + (fun x0 : setT (* Top.405 *) X0 => + @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit" +instead of + "@paths (* Top.413 *) Type (* Set *) + (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) + (fun x0 : setT (* Top.405 *) X0 => + @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit". + *) diff --git a/test-suite/bugs/closed/bug_3428.v b/test-suite/bugs/closed/bug_3428.v new file mode 100644 index 0000000000..4192be6d2d --- /dev/null +++ b/test-suite/bugs/closed/bug_3428.v @@ -0,0 +1,35 @@ +(* File reduced by coq-bug-finder from original input, then from 2809 lines to 39 lines *) +Set Primitive Projections. +Set Implicit Arguments. +Module Export foo. + Record prod (A B : Type) := pair { fst : A ; snd : B }. +End foo. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. +Axiom path_prod : forall {A B : Type} (z z' : prod A B), (fst z = fst z') -> (snd z = snd z') -> (z = z'). +Notation fst := (@fst _ _). +Notation snd := (@snd _ _). +Definition ap_fst_path_prod {A B : Type} {z z' : prod A B} (p : @paths A (fst z) (fst z')) (q : snd z = snd z') +: ap fst (path_prod z z' p q) = p. +Abort. + +Notation fstp x := (x.(foo.fst)). +Notation fstap x := (foo.fst x). + +Definition ap_fst_path_prod' {A B : Type} {z z' : prod A B} (p : @paths A (fst z) (fst z')) (q : snd z = snd z') +: ap (fun x => fstap x) (path_prod z z' p q) = p. + +Abort. + +(* Toplevel input, characters 137-138: +Error: +In environment +A : Type +B : Type +z : prod A B +z' : prod A B +p : @paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z') +q : @paths ?54 (foo.snd ?42 ?45 z) (foo.snd ?57 ?60 z') +The term "p" has type "@paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z')" +while it is expected to have type "@paths A (foo.fst z) (foo.fst z')". *) diff --git a/test-suite/bugs/closed/bug_3439.v b/test-suite/bugs/closed/bug_3439.v new file mode 100644 index 0000000000..e8c2d8b8ca --- /dev/null +++ b/test-suite/bugs/closed/bug_3439.v @@ -0,0 +1,44 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 3154 lines to 149 lines, then from 89 lines to 55 lines, then from 44 lines to 20 lines *) +Set Primitive Projections. +Generalizable All Variables. +Axiom IsHSet : Type -> Type. +Existing Class IsHSet. +Record PreCategory := { object :> Type }. +Notation IsStrictCategory C := (IsHSet (object C)). +Instance trunc_prod `{IsHSet A} `{IsHSet B} : IsHSet (A * B) | 100. +admit. +Defined. +Typeclasses Transparent object. +Definition prod (C D : PreCategory) : PreCategory := Build_PreCategory (Datatypes.prod C D). +Global Instance isstrict_category_product `{IsStrictCategory C, IsStrictCategory D} : IsStrictCategory (prod C D). +Proof. + typeclasses eauto. +Defined. + + +Set Typeclasses Debug. +(* File reduced by coq-bug-finder from original input, then from 7425 lines to 154 lines, then from 116 lines to 20 lines *) +Class Contr (A : Type) := { center : A }. +Instance contr_unit : Contr unit | 0 := {| center := tt |}. +Module non_prim. + Unset Primitive Projections. + Record PreCategory := { object :> Type }. + Lemma foo : Contr (object (@Build_PreCategory unit)). + Proof. + solve [ simpl; typeclasses eauto ] || fail "goal not solved". + Undo. + solve [ typeclasses eauto ]. + Defined. +End non_prim. + +Module prim. + Set Primitive Projections. + Record PreCategory := { object :> Type }. + Lemma foo : Contr (object (@Build_PreCategory unit)). + Proof. + solve [ simpl; typeclasses eauto ] || fail "goal not solved". + Undo. + solve [ typeclasses eauto ]. (* Error: No applicable tactic. *) + Defined. +End prim. diff --git a/test-suite/bugs/closed/bug_3441.v b/test-suite/bugs/closed/bug_3441.v new file mode 100644 index 0000000000..d48c059acb --- /dev/null +++ b/test-suite/bugs/closed/bug_3441.v @@ -0,0 +1,23 @@ +Axiom f : nat -> nat -> nat. +Fixpoint do_n (n : nat) (k : nat) := + match n with + | 0 => k + | S n' => do_n n' (f k k) + end. + +Notation big := (_ = _). +Axiom k : nat. +Goal True. +Timeout 1 let H := fresh "H" in + let x := constr:(let n := 17 in do_n n = do_n n) in + let y := (eval lazy in x) in + pose proof y as H. (* Finished transaction in 1.102 secs (1.084u,0.016s) (successful) *) +Timeout 1 let H := fresh "H" in + let x := constr:(let n := 17 in do_n n = do_n n) in + let y := (eval lazy in x) in + pose y as H; clearbody H. (* Finished transaction in 0.412 secs (0.412u,0.s) (successful) *) + +Timeout 1 Time let H := fresh "H" in + let x := constr:(let n := 17 in do_n n = do_n n) in + let y := (eval lazy in x) in + assert (H := y). (* Finished transaction in 1.19 secs (1.164u,0.024s) (successful) *) diff --git a/test-suite/bugs/closed/bug_3446.v b/test-suite/bugs/closed/bug_3446.v new file mode 100644 index 0000000000..57e0efea8e --- /dev/null +++ b/test-suite/bugs/closed/bug_3446.v @@ -0,0 +1,51 @@ +(* File reduced by coq-bug-finder from original input, then from 7372 lines to 539 lines, then from 531 lines to 107 lines, then from 76 lines to 46 lines *) +Module First. +Set Asymmetric Patterns. +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Notation "A -> B" := (forall (_ : A), B). +Set Universe Polymorphism. + + +Notation "x → y" := (x -> y) + (at level 99, y at level 200, right associativity): type_scope. +Record sigT A (P : A -> Type) := + { projT1 : A ; projT2 : P projT1 }. +Arguments projT1 {A P} s. +Arguments projT2 {A P} s. +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Reserved Notation "x = y" (at level 70, no associativity). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y). +Notation " x = y " := (paths x y) : type_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Reserved Notation "{ x : A & P }" (at level 0, x at level 99). +Notation "{ x : A & P }" := (sigT A (fun x => P)) : type_scope. + + +Axiom path_sigma_uncurried : forall {A : Type} (P : A -> Type) (u v : sigT A P) (pq : {p : projT1 u = projT1 v & transport _ p (projT2 u) = projT2 v}), u = v. +Axiom isequiv_pr1_contr : forall {A} {P : A -> Type}, (A -> {x : A & P x}). + +Definition path_sigma_hprop {A : Type} {P : A -> Type} (u v : sigT _ P) := + @compose _ _ _ (path_sigma_uncurried P u v) (@isequiv_pr1_contr _ _). +End First. + +Set Asymmetric Patterns. +Set Universe Polymorphism. +Arguments projT1 {_ _} _. +Notation "( x ; y )" := (existT _ x y). +Notation pr1 := projT1. +Notation "x .1" := (projT1 x) (at level 3). +Notation "x .2" := (projT2 x) (at level 3). +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Notation "g 'o' f" := (compose g f) (at level 40, left associativity). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3). +Axiom path_sigma_uncurried : forall {A : Type} (P : A -> Type) (u v : sigT P) (pq : {p : u.1 = v.1 & p # u.2 = v.2}), u = v. +Instance isequiv_pr1_contr {A} {P : A -> Type} : IsEquiv (@pr1 A P) | 100. +Admitted. + +Definition path_sigma_hprop {A : Type} {P : A -> Type} (u v : sigT P) : u.1 = v.1 -> u = v := + path_sigma_uncurried P u v o pr1^-1. diff --git a/test-suite/bugs/closed/bug_3453.v b/test-suite/bugs/closed/bug_3453.v new file mode 100644 index 0000000000..4ee9b400a3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3453.v @@ -0,0 +1,10 @@ +Set Primitive Projections. +Record Foo := { bar : Set }. +Class Baz (F : Foo) := { qux : F.(bar) }. +Coercion qux : Baz >-> bar. + +Definition f : Foo := {| bar := nat |}. +Canonical Structure f. +Check (fun b : Baz f => b : _.(bar)). + +(* Error: Found target class bar instead of bar. *) diff --git a/test-suite/bugs/closed/bug_3454.v b/test-suite/bugs/closed/bug_3454.v new file mode 100644 index 0000000000..e4cd60cb24 --- /dev/null +++ b/test-suite/bugs/closed/bug_3454.v @@ -0,0 +1,63 @@ +Set Primitive Projections. +Set Implicit Arguments. + +Record prod {A} {B}:= pair { fst : A ; snd : B }. +Notation " A * B " := (@prod A B) : type_scope. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Notation pr1 := (@projT1 _ _). +Arguments prod : clear implicits. + +Check (@projT1 _ (fun x : nat => x = x)). +Check (fun s : @sigT nat (fun x : nat => x = x) => s.(projT1)). + +Record rimpl {b : bool} {n : nat} := { foo : forall {x : nat}, x = n }. + +Check (fun r : @rimpl true 0 => r.(foo) (x:=0)). +Check (fun r : @rimpl true 0 => @foo true 0 r 0). +Check (fun r : @rimpl true 0 => foo r (x:=0)). +Check (fun r : @rimpl true 0 => @foo _ _ r 0). +Check (fun r : @rimpl true 0 => r.(@foo _ _)). +Check (fun r : @rimpl true 0 => r.(foo)). + +Notation "{ x : T & P }" := (@sigT T P). +Notation "{ x : A & P }" := (sigT (A:=A) (fun x => P)) : type_scope. +(* Notation "{ x : T * U & P }" := (@sigT (T * U) P). *) + +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Class IsEquiv {A B : Type} (f : A -> B) := {}. + +Local Instance isequiv_tgt_compose A B +: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) + (A -> B) + (@compose A {xy : B * B & fst xy = snd xy} B + (@compose {xy : B * B & fst xy = snd xy} _ B (@snd B B) pr1)). +(* Toplevel input, characters 220-223: *) +(* Error: Cannot infer this placeholder. *) + +Local Instance isequiv_tgt_compose' A B +: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) + (A -> B) + (@compose A {xy : B * B & fst xy = snd xy} B (@compose {xy : B * B & fst xy = snd xy} _ B (@snd _ _) pr1)). +(* Toplevel input, characters 221-232: *) +(* Error: *) +(* In environment *) +(* A : Type *) +(* B : Type *) +(* The term "pr1" has type "sigT ?30 -> ?29" while it is expected to have type *) +(* "{xy : B * B & fst xy = snd xy} -> ?27 * B". *) + +Local Instance isequiv_tgt_compose'' A B +: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) + (A -> B) + (@compose A {xy : B * B & fst xy = snd xy} B (@compose {xy : B * B & fst xy = snd xy} _ B (@snd _ _) + (fun s => s.(projT1)))). +(* Toplevel input, characters 15-241: +Error: +Cannot infer an internal placeholder of type "Type" in environment: + +A : Type +B : Type +x : ?32 +. *) diff --git a/test-suite/bugs/closed/bug_3461.v b/test-suite/bugs/closed/bug_3461.v new file mode 100644 index 0000000000..1885568bd2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3461.v @@ -0,0 +1,5 @@ +Lemma foo (b : bool) : + exists x : nat, x = x. +Proof. +eexists. +Fail eexact (eq_refl b). diff --git a/test-suite/bugs/closed/bug_3467.v b/test-suite/bugs/closed/bug_3467.v new file mode 100644 index 0000000000..88ae030578 --- /dev/null +++ b/test-suite/bugs/closed/bug_3467.v @@ -0,0 +1,6 @@ +Module foo. + Notation x := ltac:(exact I). +End foo. +Module bar. + Include foo. +End bar. diff --git a/test-suite/bugs/closed/bug_3469.v b/test-suite/bugs/closed/bug_3469.v new file mode 100644 index 0000000000..6aa3b56f8b --- /dev/null +++ b/test-suite/bugs/closed/bug_3469.v @@ -0,0 +1,29 @@ +(* File reduced by coq-bug-finder from original input, then from 538 lines to 31 lines *) +Open Scope type_scope. +Global Set Primitive Projections. +Set Implicit Arguments. +Record sig (A : Type) (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. +Notation sigT := sig (only parsing). +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. +Notation projT1 := proj1_sig (only parsing). +Notation projT2 := proj2_sig (only parsing). +Variables X : Type. +Variable R : X -> X -> Type. +Lemma dependent_choice : + (forall x:X, {y : _ & R x y}) -> + forall x0, {f : nat -> X & (f O = x0) * (forall n, R (f n) (f (S n)))}. +Proof. + intros H x0. + set (f:=fix f n := match n with O => x0 | S n' => projT1 (H (f n')) end). + exists f. + split. + reflexivity. + induction n; simpl in *. + clear. + apply (proj2_sig (H x0)). + Undo. + apply @proj2_sig. + + +(* Toplevel input, characters 21-31: +Error: Found no subterm matching "proj1_sig ?206" in the current *) diff --git a/test-suite/bugs/closed/bug_3477.v b/test-suite/bugs/closed/bug_3477.v new file mode 100644 index 0000000000..3ed63604ea --- /dev/null +++ b/test-suite/bugs/closed/bug_3477.v @@ -0,0 +1,9 @@ +Set Primitive Projections. +Set Implicit Arguments. +Record prod A B := pair { fst : A ; snd : B }. +Goal forall A B : Set, True. +Proof. + intros A B. + evar (a : prod A B); evar (f : (prod A B -> Set)). + let a' := (eval unfold a in a) in + set(foo:=eq_refl : a' = (@pair _ _ (fst a') (snd a'))). diff --git a/test-suite/bugs/closed/bug_3480.v b/test-suite/bugs/closed/bug_3480.v new file mode 100644 index 0000000000..35e0c51a93 --- /dev/null +++ b/test-suite/bugs/closed/bug_3480.v @@ -0,0 +1,48 @@ +Require Import TestSuite.admit. +Set Primitive Projections. +Axiom admit : forall {T}, T. +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Set Implicit Arguments. +Delimit Scope category_scope with category. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Local Open Scope category_scope. +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. +Class Isomorphic {C : PreCategory} s d := { morphism_isomorphic :> @morphism C s d ; isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. +Coercion morphism_isomorphic : Isomorphic >-> morphism. +Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. +Definition idtoiso (C : PreCategory) (x y : C) (H : x = y) : Isomorphic x y := admit. +Record NotionOfStructure (X : PreCategory) := { structure :> X -> Type }. +Record Smorphism (X : PreCategory) (P : NotionOfStructure X) (xa yb : { x : X & P x }) := { f : morphism X xa.1 yb.1 }. +Definition precategory_of_structures X (P : NotionOfStructure X) : PreCategory. +Proof. + refine (@Build_PreCategory _ (@Smorphism _ P)). +Defined. +Section sip. + Variable X : PreCategory. + Variable P : NotionOfStructure X. + + Let StrX := @precategory_of_structures X P. + + Definition sip_isotoid (xa yb : StrX) (f : xa <~=~> yb) : xa = yb. + admit. + Defined. + + Lemma structure_identity_principle_helper (xa yb : StrX) + (x : xa <~=~> yb) : Smorphism P xa yb. + Proof. + refine ((idtoiso (precategory_of_structures P) (sip_isotoid x) : @morphism _ _ _) : morphism _ _ _). +(* Toplevel input, characters 24-95: +Error: +In environment +X : PreCategory +P : NotionOfStructure X +StrX := precategory_of_structures P : PreCategory +xa : object StrX +yb : object StrX +x : xa <~=~> yb +The term "morphism_isomorphic:@morphism (precategory_of_structures P) xa yb" +has type "@morphism (precategory_of_structures P) xa yb" +while it is expected to have type "morphism ?40 ?41 ?42". *) diff --git a/test-suite/bugs/closed/bug_3481.v b/test-suite/bugs/closed/bug_3481.v new file mode 100644 index 0000000000..41e1a8e959 --- /dev/null +++ b/test-suite/bugs/closed/bug_3481.v @@ -0,0 +1,67 @@ + +Set Implicit Arguments. + +Require Import Logic. +Module NonPrim. +Local Set Nonrecursive Elimination Schemes. +Record prodwithlet (A B : Type) : Type := + pair' { fst : A; fst' := fst; snd : B }. + +Definition letreclet (p : prodwithlet nat nat) := + let (x, x', y) := p in x + y. + +Definition pletreclet (p : prodwithlet nat nat) := + let 'pair' x x' y := p in x + y + x'. + +Definition pletreclet2 (p : prodwithlet nat nat) := + let 'pair' x y := p in x + y. + +Check (pair 0 0). +End NonPrim. + +Global Set Universe Polymorphism. +Global Set Asymmetric Patterns. +Local Set Nonrecursive Elimination Schemes. +Local Set Primitive Projections. + +Record prod (A B : Type) : Type := + pair { fst : A; snd : B }. + +Print prod_rect. + +(* What I really want: *) +Definition prod_rect' A B (P : prod A B -> Type) (u : forall (fst : A) (snd : B), P (pair fst snd)) + (p : prod A B) : P p + := u (fst p) (snd p). + +Definition conv : @prod_rect = @prod_rect'. +Proof. reflexivity. Defined. + +Definition imposs := + (fun A B P f (p : prod A B) => match p as p0 return P p0 with + | {| fst := x ; snd := x0 |} => f x x0 + end). + +Definition letrec (p : prod nat nat) := + let (x, y) := p in x + y. +Eval compute in letrec (pair 1 5). + +Goal forall p : prod nat nat, letrec p = fst p + snd p. +Proof. + reflexivity. + Undo. + intros p. + case p. simpl. unfold letrec. simpl. reflexivity. +Defined. + +Eval compute in conv. (* = eq_refl + : prod_rect = prod_rect' *) + +Check eq_refl : @prod_rect = @prod_rect'. (* Toplevel input, characters 6-13: +Error: +The term "eq_refl" has type "prod_rect = prod_rect" +while it is expected to have type "prod_rect = prod_rect'" +(cannot unify "prod_rect" and "prod_rect'"). *) + +Record sigma (A : Type) (B : A -> Type) : Type := + dpair { pi1 : A ; pi2 : B pi1 }. diff --git a/test-suite/bugs/closed/bug_3482.v b/test-suite/bugs/closed/bug_3482.v new file mode 100644 index 0000000000..87fd2723c9 --- /dev/null +++ b/test-suite/bugs/closed/bug_3482.v @@ -0,0 +1,11 @@ +Set Primitive Projections. +Class Foo (F : False) := { foo : True }. +Arguments foo F {Foo}. +Print Implicit foo. (* foo : forall F : False, Foo F -> True + +Argument Foo is implicit and maximally inserted *) +Check foo _. (* Toplevel input, characters 6-11: +Error: Illegal application (Non-functional construction): +The expression "foo" of type "True" +cannot be applied to the term + "?36" : "?35" *) diff --git a/test-suite/bugs/closed/bug_3483.v b/test-suite/bugs/closed/bug_3483.v new file mode 100644 index 0000000000..970363f00a --- /dev/null +++ b/test-suite/bugs/closed/bug_3483.v @@ -0,0 +1,4 @@ +(* Check proper failing when using notation of non-constructors in + pattern-bmatching *) + +Fail Definition nonsense ( x : False ) := match x with y + 2 => 0 end. diff --git a/test-suite/bugs/closed/bug_3484.v b/test-suite/bugs/closed/bug_3484.v new file mode 100644 index 0000000000..aa25bde9cd --- /dev/null +++ b/test-suite/bugs/closed/bug_3484.v @@ -0,0 +1,31 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 14259 lines to 305 lines, then from 237 lines to 120 lines, then from 100 lines to 30 lines *) +Set Primitive Projections. +Set Implicit Arguments. +Record sigT (A : Type) (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Notation "{ x : A & P }" := (@sigT A (fun x : A => P)) : type_scope. +Notation pr1 := (@projT1 _ _). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. +Goal forall (T : Type) (H : { g : T & g = g }) (x : T), projT1 H = projT1 (existT (fun g : T => g = g) x idpath). +Proof. + intros. + let y := match goal with |- projT1 ?x = projT1 ?y => constr:(y) end in + apply (@ap _ _ pr1 _ y). + Undo. + Unset Printing Notations. + apply (ap pr1). + Undo. + refine (ap pr1 _). +admit. +Defined. + +(* Toplevel input, characters 22-28: +Error: +In environment +T : Type +H : sigT T (fun g : T => paths g g) +x : T +Unable to unify "paths (@projT1 ?24 ?23 ?25) (@projT1 ?24 ?23 ?26)" with + "paths (projT1 H) (projT1 {| projT1 := x; projT2 := idpath |})". *) diff --git a/test-suite/bugs/closed/bug_3485.v b/test-suite/bugs/closed/bug_3485.v new file mode 100644 index 0000000000..ede6b3cb27 --- /dev/null +++ b/test-suite/bugs/closed/bug_3485.v @@ -0,0 +1,133 @@ +Set Universe Polymorphism. +Set Primitive Projections. +Reserved Infix "o" (at level 40, left associativity). +Definition relation (A : Type) := A -> A -> Type. +Class Transitive {A} (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z. +Tactic Notation "etransitivity" open_constr(y) := + let R := match goal with |- ?R ?x ?z => constr:(R) end in + let x := match goal with |- ?R ?x ?z => constr:(x) end in + let z := match goal with |- ?R ?x ?z => constr:(z) end in + refine (@transitivity _ R _ x y z _ _). +Tactic Notation "etransitivity" := etransitivity _. +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. +Notation "x .2" := (projT2 x) (at level 3) : fibration_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. +Instance transitive_paths {A} : Transitive (@paths A) | 0 := @concat A. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. +Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center = y) }. +Generalizable Variables X A B C f g n. +Definition projT1_path `{P : A -> Type} {u v : sigT P} (p : u = v) : u.1 = v.1 := ap (@projT1 _ _) p. +Notation "p ..1" := (projT1_path p) (at level 3) : fibration_scope. +Ltac simpl_do_clear tac term := + let H := fresh in + assert (H := term); + simpl in H |- *; + tac H; + clear H. +Set Implicit Arguments. +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g); + + left_identity : forall a b (f : morphism a b), identity b o f = f; + right_identity : forall a b (f : morphism a b), f o identity a = f }. +Arguments identity {C%category} / x%object : rename. +Arguments compose {C%category} / {s d d'}%object (m1 m2)%morphism : rename. +Infix "o" := compose : morphism_scope. +Notation "1" := (identity _) : morphism_scope. +Delimit Scope functor_scope with functor. +Local Open Scope morphism_scope. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d); + identity_of : forall x, morphism_of _ _ (identity x) + = identity (object_of x) }. +Bind Scope functor_scope with Functor. +Arguments morphism_of [C%category] [D%category] F%functor / [s%object d%object] m%morphism : rename. +Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. +Section composition. + Variable C : PreCategory. + Variable D : PreCategory. + Variable E : PreCategory. + Variable G : Functor D E. + Variable F : Functor C D. + + Local Notation c_object_of c := (G (F c)) (only parsing). + Local Notation c_morphism_of m := (morphism_of G (morphism_of F m)) (only parsing). + + Definition compose_identity_of x + : c_morphism_of (identity x) = identity (c_object_of x) + := transport (@paths _ _) + (identity_of G _) + (ap (@morphism_of _ _ G _ _) (identity_of F x)). + + Definition composeF : Functor C E + := Build_Functor + C E + (fun c => G (F c)) + (fun _ _ m => morphism_of G (morphism_of F m)) + compose_identity_of. +End composition. +Infix "o" := composeF : functor_scope. + +Definition identityF C : Functor C C + := Build_Functor C C + (fun x => x) + (fun _ _ x => x) + (fun _ => idpath). +Notation "1" := (identityF _) : functor_scope. + +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. + +Section unit. + Variable C : PreCategory. + Variable D : PreCategory. + Variable F : Functor C D. + Variable G : Functor D C. + + Definition AdjunctionUnit := + { T : NaturalTransformation 1 (G o F) + & forall (c : C) (d : D) (f : morphism C c (G d)), + Contr_internal { g : morphism D (F c) d & G _1 g o T c = f } + }. +End unit. +Variable C : PreCategory. +Variable D : PreCategory. +Variable F : Functor C D. +Variable G : Functor D C. + +Definition zig__of__adjunction_unit + (A : AdjunctionUnit F G) + (Y : C) + (eta := A.1) + (eps := fun X => (@center _ (A.2 (G X) X 1)).1) +: G _1 (eps (F Y) o F _1 (eta Y)) o eta Y = eta Y + -> eps (F Y) o F _1 (eta Y) = 1. +Proof. + intros. + etransitivity; [ symmetry | ]; + simpl_do_clear + ltac:(fun H => apply H) + (fun y H => (@contr _ (A.2 _ _ (A.1 Y)) (y; H))..1); + try assumption. + simpl. + rewrite ?@identity_of, ?@left_identity, ?@right_identity; + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_3487.v b/test-suite/bugs/closed/bug_3487.v new file mode 100644 index 0000000000..1321a8598c --- /dev/null +++ b/test-suite/bugs/closed/bug_3487.v @@ -0,0 +1,8 @@ +Notation bar := ltac:(exact I). +Notation foo := bar (only parsing). +Class baz := { x : False }. +Instance: baz. +Admitted. +Definition baz0 := ((_ : baz) = (_ : baz)). +Definition foo1 := (foo = foo). +Definition baz1 := prod ((_ : baz) = (_ : baz)) (foo = foo). diff --git a/test-suite/bugs/closed/bug_3490.v b/test-suite/bugs/closed/bug_3490.v new file mode 100644 index 0000000000..957736d0b9 --- /dev/null +++ b/test-suite/bugs/closed/bug_3490.v @@ -0,0 +1,27 @@ +Inductive T : Type := +| Var : nat -> T +| Arr : T -> T -> T. + +Inductive Tele : list T -> Type := +| Tnil : @Tele nil +| Tcons : forall ls, forall (t : @Tele ls) (l : T), @Tele (l :: ls). + +Fail Fixpoint TeleD (ls : list T) (t : Tele ls) {struct t} + : { x : Type & x -> nat -> Type } := + match t return { x : Type & x -> nat -> Type } with + | Tnil => @existT Type (fun x => x -> nat -> Type) unit (fun (_ : unit) (_ : nat) => unit) + | Tcons ls t' l => + let (result, get) := TeleD ls t' in + @existT Type (fun x => x -> nat -> Type) + { v : result & (fix TD (t : T) {struct t} := + match t with + | Var n => + get v n + | Arr a b => TD a -> TD b + end) l } + (fun x n => + match n return Type with + | 0 => projT2 x + | S n => get (projT1 x) n + end) + end. diff --git a/test-suite/bugs/closed/bug_3491.v b/test-suite/bugs/closed/bug_3491.v new file mode 100644 index 0000000000..fd394ddbc3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3491.v @@ -0,0 +1,4 @@ +(* Was failing while building the _rect scheme, due to wrong computation of *) +(* the number of non recursively uniform parameters in the presence of let-ins*) +Inductive list (A : Type) (T := A) : Type := + nil : list A | cons : T -> list T -> list A. diff --git a/test-suite/bugs/closed/bug_3495.v b/test-suite/bugs/closed/bug_3495.v new file mode 100644 index 0000000000..102a2aba0d --- /dev/null +++ b/test-suite/bugs/closed/bug_3495.v @@ -0,0 +1,18 @@ +Require Import RelationClasses. + +Axiom R : Prop -> Prop -> Prop. +Declare Instance : Reflexive R. + +Class bar := { x : False }. +Record foo := { a : Prop ; b : bar }. + +Definition default_foo (a0 : Prop) `{b : bar} : foo := {| a := a0 ; b := b |}. + +Goal exists k, R k True. +Proof. +eexists. +evar (b : bar). +let e := match goal with |- R ?e _ => constr:(e) end in +unify e (a (default_foo True)). +subst b. +reflexivity. diff --git a/test-suite/bugs/closed/bug_3505.v b/test-suite/bugs/closed/bug_3505.v new file mode 100644 index 0000000000..2695bc796e --- /dev/null +++ b/test-suite/bugs/closed/bug_3505.v @@ -0,0 +1,44 @@ +(* File reduced by coq-bug-finder from original input, then from 7421 lines to 6082 lines, then from 5860 lines to 5369 lines, then from 5300 lines to 165 lines, then from 111 lines to 38 lines *) +Set Implicit Arguments. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + identity : forall x, morphism x x }. +Bind Scope category_scope with PreCategory. +Local Notation "1" := (identity _ _) : morphism_scope. +Local Open Scope morphism_scope. +Definition prod (C D : PreCategory) : PreCategory + := @Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) * morphism D (snd s) (snd d))%type) + (fun x => (identity _ (fst x), identity _ (snd x))). +Local Infix "*" := prod : category_scope. +Module NonPrim. + Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); + identity_of : forall x, morphism_of _ _ (identity _ x) = identity _ (object_of x) }. + Notation "F '_1' m" := (morphism_of F _ _ m) (at level 10, no associativity) : morphism_scope. + Goal forall C1 C2 D (F : Functor (C1 * C2) D) x, F _1 (1, 1) = identity _ (F x). + Proof. + intros. + rewrite identity_of. + reflexivity. + Qed. +End NonPrim. +Module Prim. + Set Primitive Projections. + Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); + identity_of : forall x, morphism_of _ _ (identity _ x) = identity _ (object_of x) }. + Notation "F '_1' m" := (morphism_of F _ _ m) (at level 10, no associativity) : morphism_scope. + Goal forall C1 C2 D (F : Functor (C1 * C2) D) x, F _1 (1, 1) = identity _ (F x). + Proof. + intros. + rewrite identity_of. (* Toplevel input, characters 0-20: +Error: +Found no subterm matching "morphism_of ?192 ?193 ?193 (identity ?190 ?193)" in the current goal. *) + reflexivity. + Qed. +End Prim. diff --git a/test-suite/bugs/closed/bug_3509.v b/test-suite/bugs/closed/bug_3509.v new file mode 100644 index 0000000000..8226622670 --- /dev/null +++ b/test-suite/bugs/closed/bug_3509.v @@ -0,0 +1,6 @@ +Inductive T := Foo : T. +Axiom (b : T) (R : forall x : T, Prop) (f : forall x : T, R x). +Axiom a1 : match b with Foo => f end = f. +Axiom a2 : match b with Foo => f b end = f b. +Hint Rewrite a1 : bar. +Hint Rewrite a2 : bar. diff --git a/test-suite/bugs/closed/bug_3510.v b/test-suite/bugs/closed/bug_3510.v new file mode 100644 index 0000000000..4cbae33590 --- /dev/null +++ b/test-suite/bugs/closed/bug_3510.v @@ -0,0 +1,5 @@ +Inductive T := Foo : T. +Axiom (b : T) (R : forall x : T, Prop) (f : forall x : T, R x). +Axiom a1 : match b with Foo => f end = f. +Axiom a2 : match b with Foo => f b end = f b. +Hint Rewrite a1 a2 : bar. diff --git a/test-suite/bugs/closed/bug_3513.v b/test-suite/bugs/closed/bug_3513.v new file mode 100644 index 0000000000..f17fb2d9d0 --- /dev/null +++ b/test-suite/bugs/closed/bug_3513.v @@ -0,0 +1,73 @@ +(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines *) +Require Coq.Setoids.Setoid. +Import Coq.Setoids.Setoid. +Generalizable All Variables. +Axiom admit : forall {T}, T. +Class Equiv (A : Type) := equiv : relation A. +Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. +Class ILogicOps Frm := { lentails: relation Frm; + ltrue: Frm; + land: Frm -> Frm -> Frm; + lor: Frm -> Frm -> Frm }. +Infix "|--" := lentails (at level 79, no associativity). +Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }. +Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P. +Infix "-|-" := lequiv (at level 85, no associativity). +Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit. +Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }. +Section ILogic_Fun. + Context (T: Type) `{TType: type T}. + Context `{IL: ILogic Frm}. + Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. + Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. +End ILogic_Fun. +Arguments ILFunFrm _ {e} _ {ILOps}. +Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; + ltrue := True; + land P Q := P /\ Q; + lor P Q := P \/ Q |}. +Axiom Action : Set. +Definition Actions := list Action. +Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }. +Definition OPred := ILFunFrm Actions Prop. +Local Existing Instance ILFun_Ops. +Local Existing Instance ILFun_ILogic. +Definition catOP (P Q: OPred) : OPred := admit. +Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. +apply admit. +Defined. +Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. +Class IsPointed (T : Type) := point : T. +Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). +Record PointedOPred := mkPointedOPred { + OPred_pred :> OPred; + OPred_inhabited: IsPointed_OPred OPred_pred + }. +Existing Instance OPred_inhabited. +Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred + := {| OPred_pred := O ; OPred_inhabited := _ |}. +Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit. +Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) + (tr : T -> T) (O2 : PointedOPred) (x : T) + (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0), + exists e1 e2, + catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2. + intros; do 2 esplit. + rewrite <- catOPA. + lazymatch goal with + | |- ?R (?f ?a ?b) (?f ?a' ?b') => + let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred) + (@Morphisms.respectful OPred (OPred -> OPred) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop)) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==> + @lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP + catOP_entails_m_Proper a a' H b b' H') in + pose P; + refine (P _ _) + end; unfold Basics.flip. + Focus 2. + (* As in 8.5, allow a shelved subgoal to remain *) + apply reflexivity. diff --git a/test-suite/bugs/closed/bug_3520.v b/test-suite/bugs/closed/bug_3520.v new file mode 100644 index 0000000000..01bf6667f2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3520.v @@ -0,0 +1,9 @@ +Set Primitive Projections. + +Record foo (A : Type) := + { bar : Type ; baz := Set; bad : baz = bar }. + +Set Nonrecursive Elimination Schemes. + +Record notprim : Prop := + { irrel : True; relevant : nat }. diff --git a/test-suite/bugs/closed/bug_3531.v b/test-suite/bugs/closed/bug_3531.v new file mode 100644 index 0000000000..552092bc39 --- /dev/null +++ b/test-suite/bugs/closed/bug_3531.v @@ -0,0 +1,54 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 270 lines to +198 lines, then from 178 lines to 82 lines, then from 88 lines to 59 lines *) +(* coqc version trunk (August 2014) compiled on Aug 19 2014 14:40:15 with OCaml +4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk +(56ece74efc25af1b0e09265f3c7fcf74323abcaf) *) +Require Import Coq.Lists.List. +Set Implicit Arguments. +Definition mem := nat -> option nat. +Definition pred := mem -> Prop. +Delimit Scope pred_scope with pred. +Definition exis A (p : A -> pred) : pred := fun m => exists x, p x m. +Notation "'exists' x .. y , p" := (exis (fun x => .. (exis (fun y => p)) ..)) : +pred_scope. +Definition emp : pred := fun m => forall a, m a = None. +Definition lift_empty (P : Prop) : pred := fun m => P /\ forall a, m a = None. +Notation "[[ P ]]" := (lift_empty P) : pred_scope. +Definition pimpl (p q : pred) := forall m, p m -> q m. +Notation "p ==> q" := (pimpl p%pred q%pred) (right associativity, at level 90). +Definition piff (p q : pred) : Prop := (p ==> q) /\ (q ==> p). +Notation "p <==> q" := (piff p%pred q%pred) (at level 90). +Parameter sep_star : pred -> pred -> pred. +Infix "*" := sep_star : pred_scope. +Definition memis (m : mem) : pred := eq m. +Definition mptsto (m : mem) (a : nat) (v : nat) := m a = Some v. +Notation "m @ a |-> v" := (mptsto m a v) (a at level 34, at level 35). +Lemma piff_trans: forall a b c, (a <==> b) -> (b <==> c) -> (a <==> c). +Admitted. +Lemma piff_refl: forall a, (a <==> a). +Admitted. +Definition stars (ps : list pred) := fold_left sep_star ps emp. +Lemma flatten_exists: forall T PT p ps P, + (forall (a:T), (p a <==> exists (x:PT), stars (ps a x) * [[P a x]])) + -> (exists (a:T), p a) <==> + (exists (x:(T*PT)), stars (ps (fst x) (snd x)) * [[P (fst x) (snd x)]]). +Admitted. +Goal forall b, (exists e1 e2 e3, + (exists (m : mem) (v : nat) (F : pred), b) + <==> (exists x : e1, stars (e2 x) * [[e3 x]])). + intros. + Set Printing Universes. + Show Universes. + do 3 eapply ex_intro. + eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. + eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. + eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. + assert (H : False) by (clear; admit); destruct H. + Grab Existential Variables. + admit. + admit. + admit. + Show Universes. +Time Qed. diff --git a/test-suite/bugs/closed/bug_3537.v b/test-suite/bugs/closed/bug_3537.v new file mode 100644 index 0000000000..158642f01d --- /dev/null +++ b/test-suite/bugs/closed/bug_3537.v @@ -0,0 +1,12 @@ +(* Another instance of bug #3262, on looping in unification *) + +Inductive bool := true | false. + +Inductive RBT2 : forall a:bool, Type := + Full2 : forall (a b c n:bool), + forall H:RBT2 n, RBT2 n. + +Definition balance4 color p q r := + match color, p, q, r with + | _,_,_,_ => Full2 color p q r + end. diff --git a/test-suite/bugs/closed/bug_3539.v b/test-suite/bugs/closed/bug_3539.v new file mode 100644 index 0000000000..b0c4b23702 --- /dev/null +++ b/test-suite/bugs/closed/bug_3539.v @@ -0,0 +1,66 @@ +(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 11678 lines to 11330 lines, then from 10721 lines to 9544 lines, then from 9549 lines to 794 lines, then from 810 lines to 785 lines, then from 628 lines to 246 lines, then from 220 lines to 89 lines, then from 80 lines to 47 lines *) +(* coqc version trunk (August 2014) compiled on Aug 22 2014 4:17:28 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (a67cc6941434124465f20b14a1256f2ede31a60e) *) + +Set Implicit Arguments. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Local Set Primitive Projections. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Axiom path_prod : forall {A B : Type} (z z' : A * B), (fst z = fst z') -> (snd z = snd z') -> (z = z'). +Axiom transport_path_prod : forall A B (P : A * B -> Type) (x y : A * B) (HA : fst x = fst y) (HB : snd x = snd y) Px, + transport P (path_prod _ _ HA HB) Px + = transport (fun x => P (x, snd y)) HA (transport (fun y => P (fst x, y)) HB Px). +Goal forall (T0 : Type) (snd1 snd0 f : T0) (p : @paths T0 f snd0) + (f0 : T0) (p1 : @paths T0 f0 snd1) (T1 : Type) + (fst1 fst0 : T1) (p0 : @paths T1 fst0 fst0) (p2 : @paths T1 fst1 fst1) + (T : Type) (x2 : T) (T2 : Type) (T3 : forall (_ : T2) (_ : T2), Type) + (x' : forall (_ : T1) (_ : T), T2) (m : T3 (x' fst1 x2) (x' fst0 x2)), + @paths (T3 (x' fst1 x2) (x' fst0 x2)) + (@transport (prod T1 T0) + (fun x : prod T1 T0 => + T3 (x' fst1 x2) (x' (fst x) x2)) + (@pair T1 T0 fst0 f) (@pair T1 T0 fst0 snd0) + (@path_prod T1 T0 (@pair T1 T0 fst0 f) + (@pair T1 T0 fst0 snd0) p0 p) + (@transport (prod T1 T0) + (fun x : prod T1 T0 => + T3 (x' (fst x) x2) (x' fst0 x2)) + (@pair T1 T0 fst1 f0) (@pair T1 T0 fst1 snd1) + (@path_prod T1 T0 (@pair T1 T0 fst1 f0) + (@pair T1 T0 fst1 snd1) p2 p1) m)) m. + intros. + match goal with + | [ |- context[transport ?P (path_prod ?x ?y ?HA ?HB) ?Px] ] + => rewrite (transport_path_prod P x y HA HB Px) + end || fail "bad". + Undo. + Set Printing All. + rewrite transport_path_prod. (* Toplevel input, characters 15-43: +Error: +In environment +T0 : Type +snd1 : T0 +snd0 : T0 +f : T0 +p : @paths T0 f snd0 +f0 : T0 +p1 : @paths T0 f0 snd1 +T1 : Type +fst1 : T1 +fst0 : T1 +p0 : @paths T1 fst0 fst0 +p2 : @paths T1 fst1 fst1 +T : Type +x2 : T +T2 : Type +T3 : forall (_ : T2) (_ : T2), Type +x' : forall (_ : T1) (_ : T), T2 +m : T3 (x' fst1 x2) (x' fst0 x2) +Unable to unify "?25 (@pair ?23 ?24 (fst ?27) (snd ?27))" with +"?25 ?27". + *) diff --git a/test-suite/bugs/closed/bug_3542.v b/test-suite/bugs/closed/bug_3542.v new file mode 100644 index 0000000000..b6837a0c33 --- /dev/null +++ b/test-suite/bugs/closed/bug_3542.v @@ -0,0 +1,6 @@ +Section foo. + Context {A:Type} {B : A -> Type}. + Context (f : forall x, B x). + Goal True. + pose (r := fun k => existT (fun g => forall x, f x = g x) + (fun x => projT1 (k x)) (fun x => projT2 (k x))). diff --git a/test-suite/bugs/closed/bug_3546.v b/test-suite/bugs/closed/bug_3546.v new file mode 100644 index 0000000000..55d718bd03 --- /dev/null +++ b/test-suite/bugs/closed/bug_3546.v @@ -0,0 +1,17 @@ +Set Primitive Projections. +Record prod A B := pair { fst : A ; snd : B }. +Arguments pair {_ _} _ _. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Definition ap11 {A B} {f g:A->B} (h:f=g) {x y:A} (p:x=y) : f x = g y. +Admitted. +Goal forall x y z w : Set, (x, y) = (z, w). +Proof. + intros. + apply ap11. (* Toplevel input, characters 21-25: +Error: In environment +x : Set +y : Set +z : Set +w : Set +Unable to unify "?31 ?191 = ?32 ?192" with "(x, y) = (z, w)". + *) diff --git a/test-suite/bugs/closed/bug_3554.v b/test-suite/bugs/closed/bug_3554.v new file mode 100644 index 0000000000..13a79cc840 --- /dev/null +++ b/test-suite/bugs/closed/bug_3554.v @@ -0,0 +1 @@ +Example foo (f : forall {_ : Type}, Type) : Type. diff --git a/test-suite/bugs/closed/bug_3559.v b/test-suite/bugs/closed/bug_3559.v new file mode 100644 index 0000000000..e26945c3bb --- /dev/null +++ b/test-suite/bugs/closed/bug_3559.v @@ -0,0 +1,88 @@ +Unset Strict Universe Declaration. +(* File reduced by coq-bug-finder from original input, then from 8657 lines to +4731 lines, then from 4174 lines to 192 lines, then from 161 lines to 55 lines, +then from 51 lines to 37 lines, then from 43 lines to 30 lines *) +(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml +4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk +(437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) +Require Import Coq.Init.Notations. +Set Universe Polymorphism. +Generalizable All Variables. +Record prod A B := pair { fst : A ; snd : B }. +Arguments pair {_ _} _ _. +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Reserved Notation "x <-> y" (at level 95, no associativity). +Reserved Notation "x = y" (at level 70, no associativity). +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Open Scope type_scope. + +Definition iff A B := prod (A -> B) (B -> A). +Infix "<->" := iff : type_scope. +Inductive paths {A : Type@{i}} (a : A) : A -> Type@{i} := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center += y) }. +Inductive trunc_index : Type := minus_two | trunc_S (_ : trunc_index). +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type@{i}) : Type@{i} := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. +Notation minus_one:=(trunc_S minus_two). +Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : +IsTrunc_internal n A. +Instance istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) : +IsTrunc n (x = y) := H x y. + +Axiom cheat : forall {A}, A. + +Lemma paths_lift (A : Type@{i}) (x y : A) (p : x = y) : paths@{j} x y. +Proof. + destruct p. apply idpath. +Defined. + +Lemma paths_change (A : Type@{i}) (x y : A) : paths@{j} x y = paths@{i} x y. +Proof. (* require Univalence *) + apply cheat. +Defined. + +Lemma IsTrunc_lift (n : trunc_index) : + forall (A : Type@{i}), IsTrunc_internal@{i} n A -> IsTrunc_internal@{j} n A. +Proof. + induction n; simpl; intros. + destruct X. exists center0. intros. apply (paths_lift _ _ _ (contr0 y)). + + rewrite paths_change. + apply IHn, X. +Defined. + +Notation IsHProp := (IsTrunc minus_one). +(* Record hProp := hp { hproptype :> Type ; isp : IsTrunc minus_one hproptype}. *) +(* Make the truncation proof polymorphic, i.e., available at any level greater or equal + to the carrier type level j *) +Record hProp := hp { hproptype :> Type@{j} ; isp : IsTrunc minus_one hproptype}. +Axiom path_iff_hprop_uncurried : forall `{IsHProp A, IsHProp B}, (A <-> B) -> A += B. +Inductive V : Type@{U'} := | set {A : Type@{U}} (f : A -> V) : V. +Axiom is0trunc_V : IsTrunc (trunc_S (trunc_S minus_two)) V. +Existing Instance is0trunc_V. +Axiom bisimulation : V@{U' U} -> V@{U' U} -> hProp@{U'}. +Axiom bisimulation_refl : forall (v : V), bisimulation v v. +Axiom bisimulation_eq : forall (u v : V), bisimulation u v -> u = v. +Notation "u ~~ v" := (bisimulation u v) (at level 30). +Lemma bisimulation_equals_id : forall u v : V@{i j}, (u = v) = (u ~~ v). +Proof. + intros u v. + refine (@path_iff_hprop_uncurried _ _ _ _ _). +(* path_iff_hprop_uncurried : *) +(* forall A : Type@{Top.74}, *) +(* IsHProp A -> forall B : Type@{Top.74}, IsHProp B -> A <-> B -> A = B *) +(* (* Top.74 *) +(* Top.78 |= Top.74 < Top.78 *) +(* *) *) + + Show Universes. + exact (isp _). + split; intros. destruct X. apply bisimulation_refl. + apply bisimulation_eq, X. +Defined. diff --git a/test-suite/bugs/closed/bug_3560.v b/test-suite/bugs/closed/bug_3560.v new file mode 100644 index 0000000000..a740675f30 --- /dev/null +++ b/test-suite/bugs/closed/bug_3560.v @@ -0,0 +1,15 @@ + +(* File reduced by coq-bug-finder from original input, then from 6236 lines to 1049 lines, then from 920 lines to 209 lines, then from 179 lines to 30 lines *) +(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) + +Set Primitive Projections. +Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv : forall P, P equiv_fun }. +Goal forall (A B : Type) (C : Type), Equiv (A -> B -> C) (A * B -> C). +Proof. + intros. + exists (fun u => fun x => u (fst x) (snd x)). +Abort. diff --git a/test-suite/bugs/closed/bug_3561.v b/test-suite/bugs/closed/bug_3561.v new file mode 100644 index 0000000000..06ffef6829 --- /dev/null +++ b/test-suite/bugs/closed/bug_3561.v @@ -0,0 +1,24 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 6343 lines to 2362 lines, then from 2115 lines to 303 lines, then from 321 lines to 90 lines, then from 95 lines to 41 lines *) +(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) +Set Primitive Projections. +Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). +Lemma ap_transport {A} {P Q : A -> Type} {x y : A} (p : x = y) (f : forall x, P x -> Q x) (z : P x) : + f y (p # z) = (p # (f x z)). +Proof. admit. +Defined. +Lemma foo A B (f : A * B -> A) : f = f. +Admitted. +Goal forall (H0 H2 : Type) x p, + @transport (prod H0 H2) + (fun GO : prod H0 H2 => x (fst GO)) = p. + intros. + match goal with + | [ |- context[x (?f _)] ] => set(foo':=f) + end. diff --git a/test-suite/bugs/closed/bug_3562.v b/test-suite/bugs/closed/bug_3562.v new file mode 100644 index 0000000000..1a1410a3b1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3562.v @@ -0,0 +1,6 @@ +(* Should not be an anomaly as it was at some time in + September/October 2014 but some "Disjunctive/conjunctive + introduction pattern expected" error *) + +Theorem t: True. +Fail destruct 0 as x. diff --git a/test-suite/bugs/closed/bug_3563.v b/test-suite/bugs/closed/bug_3563.v new file mode 100644 index 0000000000..961563ed4a --- /dev/null +++ b/test-suite/bugs/closed/bug_3563.v @@ -0,0 +1,38 @@ +(* File reduced by coq-bug-finder from original input, then from 11716 lines to 11295 lines, then from 10518 lines to 21 lines, then \ +from 37 lines to 21 lines *) +(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) +Set Primitive Projections. +Record prod A B := pair { fst : A ; snd : B }. +Arguments pair {A B} _ _. +Arguments fst {A B} _ / . +Arguments snd {A B} _ / . +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> H * H0) + (H4 : (fun c : H1 => (fst (H3 c), snd (H3 c))%core) = + H3) (H5 : H -> Type) (H6 H7 : H5 (fst (H3 H2))), + transport (fun y : H1 -> H * H0 => H5 (fst (y H2))) H4 H6 = H7. + intros. + match goal with + | [ |- context ctx [transport (fun y => (?g (@fst ?C ?h (y H2)))) H4 H6] ] + => set(foo:=h); idtac + end. + match goal with + | [ |- context ctx [transport (fun y => (?g (fst (y H2))))] ] + => idtac + end. +Abort. +Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> (H1 -> H) * H0) + (H4 : (fun c : H1 => (fst (H3 c), snd (H3 c))%core) = + H3) (H5 : H -> Type) (H6 H7 : H5 (fst (H3 H2) H2)), + transport (fun y : H1 -> (H1 -> H) * H0 => H5 (fst (y H2) H2)) H4 H6 = H7. + intros. + match goal with + | [ |- context ctx [transport (fun y => (?g (@fst ?C ?D (y H2) ?X)))] ] + => set(foo:=X) + end. +(* Anomaly: Uncaught exception Not_found(_). Please report. *) + +(* Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/bug_3566.v b/test-suite/bugs/closed/bug_3566.v new file mode 100644 index 0000000000..84743e48f6 --- /dev/null +++ b/test-suite/bugs/closed/bug_3566.v @@ -0,0 +1,23 @@ +Unset Strict Universe Declaration. +Notation idmap := (fun x => x). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Delimit Scope path_scope with path. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. +Notation "p @ q" := (concat p q) (at level 20) : path_scope. +Notation "p ^" := (inverse p) (at level 3, format "p '^'") : path_scope. +Class IsEquiv {A B : Type} (f : A -> B) := {}. +Axiom path_universe : forall {A B : Type} (f : A -> B) {feq : IsEquiv f}, (A = B). + +Definition Lift : Type@{i} -> Type@{j} + := Eval hnf in let lt := Type@{i} : Type@{j} in fun T => T. + +Definition lift {T} : T -> Lift T := fun x => x. + +Goal forall x y : Type, x = y. + intros. + pose proof ((fun H0 : idmap _ => (@path_universe _ _ (@lift x) (H0 x) @ + (@path_universe _ _ (@lift x) (H0 x))^)))%path as H''. diff --git a/test-suite/bugs/closed/bug_3567.v b/test-suite/bugs/closed/bug_3567.v new file mode 100644 index 0000000000..00c9c05469 --- /dev/null +++ b/test-suite/bugs/closed/bug_3567.v @@ -0,0 +1,68 @@ + +(* File reduced by coq-bug-finder from original input, then from 2901 lines to 69 lines, then from 80 lines to 63 lines *) +(* coqc version trunk (September 2014) compiled on Sep 2 2014 2:7:1 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (3c5daf4e23ee20f0788c0deab688af452e83ccf0) *) + +Set Primitive Projections. +Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Arguments fst {A B} _ / . +Arguments snd {A B} _ / . +Add Printing Let prod. +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Unset Implicit Arguments. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := + { equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) }. +Definition path_prod_uncurried {A B : Type} (z z' : A * B) (pq : (fst z = fst z') * (snd z = snd z')) +: (z = z') + := match fst pq in (_ = z'1), snd pq in (_ = z'2) return z = (z'1, z'2) with + | idpath, idpath => idpath + end. +Definition path_prod {A B : Type} (z z' : A * B) : + (fst z = fst z') -> (snd z = snd z') -> (z = z') + := fun p q => path_prod_uncurried z z' (p,q). +Definition path_prod' {A B : Type} {x x' : A} {y y' : B} +: (x = x') -> (y = y') -> ((x,y) = (x',y')) + := fun p q => path_prod (x,y) (x',y') p q. +Axiom ap_fst_path_prod : forall {A B : Type} {z z' : A * B} + (p : fst z = fst z') (q : snd z = snd z'), + ap fst (path_prod _ _ p q) = p. +Axiom ap_snd_path_prod : forall {A B : Type} {z z' : A * B} + (p : fst z = fst z') (q : snd z = snd z'), + ap snd (path_prod _ _ p q) = q. +Axiom eta_path_prod : forall {A B : Type} {z z' : A * B} (p : z = z'), + path_prod _ _(ap fst p) (ap snd p) = p. +Definition isequiv_path_prod {A B : Type} {z z' : A * B} : IsEquiv (path_prod_uncurried z z'). +Proof. + refine (Build_IsEquiv + _ _ _ + (fun r => (ap fst r, ap snd r)) + eta_path_prod + (fun pq => match pq with + | (p,q) => path_prod' + (ap_fst_path_prod p q) (ap_snd_path_prod p q) + end) _). + destruct z as [x y], z' as [x' y']. simpl. +(* Toplevel input, characters 15-50: +Error: Abstracting over the term "z" leads to a term +fun z0 : A * B => +forall x : (fst z0 = fst z') * (snd z0 = snd z'), +eta_path_prod (path_prod_uncurried z0 z' x) = +ap (path_prod_uncurried z0 z') + (let (p, q) as pq + return + ((ap (fst) (path_prod_uncurried z0 z' pq), + ap (snd) (path_prod_uncurried z0 z' pq)) = pq) := x in + path_prod' (ap_fst_path_prod p q) (ap_snd_path_prod p q)) +which is ill-typed. +Reason is: Pattern-matching expression on an object of inductive type prod +has invalid information. + *) diff --git a/test-suite/bugs/closed/bug_3584.v b/test-suite/bugs/closed/bug_3584.v new file mode 100644 index 0000000000..37fe46376e --- /dev/null +++ b/test-suite/bugs/closed/bug_3584.v @@ -0,0 +1,16 @@ +Set Primitive Projections. +Set Implicit Arguments. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Definition eta_sigma {A} {P : A -> Type} (u : sigT P) + : existT _ (projT1 u) (projT2 u) = u + := match u with existT _ x y => eq_refl end. (* Toplevel input, characters 0-139: +Error: Pattern-matching expression on an object of inductive type sigT +has invalid information. *) +Definition sum_of_sigT A B (x : sigT (fun b : bool => if b then A else B)) +: A + B + := match x with + | existT _ true a => inl a + | existT _ false b => inr b + end. (* Toplevel input, characters 0-182: +Error: Pattern-matching expression on an object of inductive type sigT +has invalid information. *) diff --git a/test-suite/bugs/closed/bug_3590.v b/test-suite/bugs/closed/bug_3590.v new file mode 100644 index 0000000000..2f15aa9ea1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3590.v @@ -0,0 +1,12 @@ +Set Implicit Arguments. +Record prod A B := pair { fst : A ; snd : B }. +Definition idS := Set. +Goal forall x y : prod Set Set, forall H : fst x = fst y, fst x = fst y. + intros. + change (@fst _ _ ?z) with (@fst Set idS z) at 2. + apply H. +Qed. + +(* Toplevel input, characters 20-58: +Error: Failed to get enough information from the left-hand side to type the +right-hand side. *) diff --git a/test-suite/bugs/closed/bug_3593.v b/test-suite/bugs/closed/bug_3593.v new file mode 100644 index 0000000000..0d7e93ee02 --- /dev/null +++ b/test-suite/bugs/closed/bug_3593.v @@ -0,0 +1,10 @@ +Set Universe Polymorphism. +Set Printing All. +Set Implicit Arguments. +Record prod A B := pair { fst : A ; snd : B }. +Goal forall x : prod Set Set, let f := @fst _ in f _ x = @fst _ _ x. +simpl; intros. + constr_eq (@fst Set Set x) (fst (A := Set) (B := Set) x). + Fail progress change (@fst Set Set x) with (fst (A := Set) (B := Set) x). + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_3594.v b/test-suite/bugs/closed/bug_3594.v new file mode 100644 index 0000000000..221fc99bfa --- /dev/null +++ b/test-suite/bugs/closed/bug_3594.v @@ -0,0 +1,51 @@ +(* File reduced by coq-bug-finder from original input, then from 8752 lines to 735 lines, then from 735 lines to 310 lines, then from 228 lines to 105 lines, then from 98 lines to 41 lines *) +(* coqc version trunk (September 2014) compiled on Sep 6 2014 6:15:6 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (3ea6d6888105edd5139ae0a4d8f8ecdb586aff6c) *) +Notation idmap := (fun x => x). +Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), (forall x, f x = g x) -> f = g. +Local Set Primitive Projections. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Bind Scope category_scope with PreCategory. +Set Implicit Arguments. +Delimit Scope functor_scope with functor. +Record Functor (C D : PreCategory) := {}. +Definition opposite (C : PreCategory) : PreCategory := @Build_PreCategory C (fun s d => morphism C d s). +Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. +Definition oppositeF C D (F : Functor C D) : Functor C^op D^op := Build_Functor (C^op) (D^op). +Local Notation "F ^op" := (oppositeF F) (at level 3, format "F ^op") : functor_scope. +Axiom oppositeF_involutive : forall C D (F : Functor C D), ((F^op)^op)%functor = F. +Local Open Scope functor_scope. +Goal forall C D : PreCategory, + (fun c : Functor C^op D^op => (c^op)^op) = idmap. + intros. + exact (path_forall (fun F : Functor C^op D^op => (F^op)^op) _ (@oppositeF_involutive _ _)). + Undo. + Unset Printing Notations. + Set Debug Unification. +(* Check (eq_refl : Build_PreCategory (opposite D).(object) *) +(* (fun s d : (opposite D).(object) => *) +(* (opposite D).(morphism) d s) = *) +(* @Build_PreCategory D (fun s d => morphism D d s)). *) +(* opposite D). *) + exact (path_forall (fun F => (F^op)^op) _ (@oppositeF_involutive _ _)). +Qed. + (* Toplevel input, characters 22-101: +Error: +In environment +C : PreCategory +D : PreCategory +The term + "path_forall + (fun F : Functor (opposite C) (opposite D) => oppositeF (oppositeF F)) + (fun F : Functor (opposite C) (opposite D) => F) + (oppositeF_involutive (D:=opposite D))" has type + "eq (fun F : Functor (opposite C) (opposite D) => oppositeF (oppositeF F)) + (fun F : Functor (opposite C) (opposite D) => F)" +while it is expected to have type + "eq (fun c : Functor (opposite C) (opposite D) => oppositeF (oppositeF c)) + (fun x : Functor (opposite C) (opposite D) => x)" +(cannot unify "{| + object := opposite D; + morphism := fun s d : opposite D => morphism (opposite D) d s |}" +and "opposite D"). + *) diff --git a/test-suite/bugs/closed/bug_3596.v b/test-suite/bugs/closed/bug_3596.v new file mode 100644 index 0000000000..69db360838 --- /dev/null +++ b/test-suite/bugs/closed/bug_3596.v @@ -0,0 +1,19 @@ +Require Import TestSuite.admit. +Set Implicit Arguments. +Record foo := { fx : nat }. +Set Primitive Projections. +Record bar := { bx : nat }. +Definition Foo (f : foo) : f = f. + destruct f as [fx]; destruct fx; admit. +Defined. +Definition Bar (b : bar) : b = b. + destruct b as [fx]; destruct fx; admit. +Defined. +Goal forall f b, Bar b = Bar b -> Foo f = Foo f. + intros f b. + destruct f, b. + simpl. + Fail progress unfold Bar. (* success *) + Fail progress unfold Foo. (* failed to progress *) + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_3612.v b/test-suite/bugs/closed/bug_3612.v new file mode 100644 index 0000000000..33e5d532ad --- /dev/null +++ b/test-suite/bugs/closed/bug_3612.v @@ -0,0 +1,54 @@ +(* -*- mode: coq; coq-prog-args: ("-indices-matter" "-nois") -*- *) +(* File reduced by coq-bug-finder from original input, then from 3595 lines to 3518 lines, then from 3133 lines to 2950 lines, then from 2911 lines to 415 lines, then from 431 lines to 407 \ +lines, then from 421 lines to 428 lines, then from 444 lines to 429 lines, then from 434 lines to 66 lines, then from 163 lines to 48 lines *) +(* coqc version trunk (September 2014) compiled on Sep 11 2014 14:48:8 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (580b25e05c7cc9e7a31430b3d9edb14ae12b7598) *) +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Reserved Notation "x = y :> T" (at level 70, y at next level, no associativity). +Reserved Notation "x = y" (at level 70, no associativity). +Delimit Scope type_scope with type. +Bind Scope type_scope with Sortclass. +Open Scope type_scope. +Global Set Universe Polymorphism. +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Generalizable All Variables. +Local Set Primitive Projections. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Arguments projT1 {A P} _ / . +Arguments projT2 {A P} _ / . +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation pr1 := projT1. +Notation pr2 := projT2. +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y . +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. +Local Open Scope path_scope. +Axiom pr1_path : forall `{P : A -> Type} {u v : sigT P} (p : u = v), u.1 = v.1. +Notation "p ..1" := (pr1_path p) (at level 3) : fibration_scope. +Axiom pr2_path : forall `{P : A -> Type} {u v : sigT P} (p : u = v), p..1 # u.2 = v.2. +Notation "p ..2" := (pr2_path p) (at level 3) : fibration_scope. +Axiom path_path_sigma : forall {A : Type} (P : A -> Type) (u v : sigT P) + (p q : u = v) + (r : p..1 = q..1) + (s : transport (fun x => transport P x u.2 = v.2) r p..2 = q..2), +p = q. + +Declare ML Module "ltac_plugin". + +Set Default Proof Mode "Classic". + +Goal forall (A : Type) (B : forall _ : A, Type) (x : @sigT A (fun x : A => B x)) + (xx : @paths (@sigT A (fun x0 : A => B x0)) x x), + @paths (@paths (@sigT A (fun x0 : A => B x0)) x x) xx + (@idpath (@sigT A (fun x0 : A => B x0)) x). + intros A B x xx. + Set Printing All. + change (fun x => B x) with B in xx. + pose (path_path_sigma B x x xx) as x''. + clear x''. + Check (path_path_sigma B x x xx). diff --git a/test-suite/bugs/closed/bug_3616.v b/test-suite/bugs/closed/bug_3616.v new file mode 100644 index 0000000000..688700260c --- /dev/null +++ b/test-suite/bugs/closed/bug_3616.v @@ -0,0 +1,3 @@ +(* Was failing from April 2014 to September 2014 because of injection *) +Goal forall P e es t, (e :: es = existT P tt t :: es)%list -> True. +inversion 1. diff --git a/test-suite/bugs/closed/bug_3618.v b/test-suite/bugs/closed/bug_3618.v new file mode 100644 index 0000000000..4b5171c082 --- /dev/null +++ b/test-suite/bugs/closed/bug_3618.v @@ -0,0 +1,103 @@ +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Notation "x = y" := (@paths _ x y) : type_scope. +Definition concat {A} {x y z : A} : x = y -> y = z -> x = z. Admitted. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x. Admitted. +Notation "p @ q" := (concat p q) (at level 20). +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y. Admitted. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y. Admitted. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : forall x, f (equiv_inv x) = x; + eissect : forall x, equiv_inv (f x) = x +}. + +Class Contr_internal (A : Type). + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. +Definition istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) +: IsTrunc n (x = y). +Admitted. + +Hint Extern 4 (IsTrunc _ (_ = _)) => eapply @istrunc_paths : typeclass_instances. + +Class Funext. + +Instance isequiv_compose A B C f g `{IsEquiv A B f} `{IsEquiv B C g} + : IsEquiv (compose g f) | 1000. +Admitted. + +Section IsEquivHomotopic. + Context (A B : Type) `(f : A -> B) `(g : A -> B) `{IsEquiv A B f} (h : forall x:A, f x = g x). + Let sect := (fun b:B => inverse (h (@equiv_inv _ _ f _ b)) @ @eisretr _ _ f _ b). + Let retr := (fun a:A => inverse (ap (@equiv_inv _ _ f _) (h a)) @ @eissect _ _ f _ a). + Global Instance isequiv_homotopic : IsEquiv g | 10000 + := ( BuildIsEquiv _ _ g (@equiv_inv _ _ f _) sect retr). +End IsEquivHomotopic. + +Instance trunc_succ A n `{IsTrunc n A} : IsTrunc (trunc_S n) A | 1000. Admitted. + +Global Instance trunc_forall A n `{P : A -> Type} `{forall a, IsTrunc n (P a)} + : IsTrunc n (forall a, P a) | 100. +Admitted. + +Instance trunc_prod A B n `{IsTrunc n A} `{IsTrunc n B} : IsTrunc n (A * B) | 100. +Admitted. + +Global Instance trunc_arrow n {A B : Type} `{IsTrunc n B} : IsTrunc n (A -> B) | 100. +Admitted. + +Instance isequiv_pr1_contr {A} {P : A -> Type} `{forall a, IsTrunc minus_two (P a)} +: IsEquiv (@projT1 A P) | 100. +Admitted. + +Instance trunc_sigma n A `{P : A -> Type} `{IsTrunc n A} `{forall a, IsTrunc n (P a)} +: IsTrunc n (sigT P) | 100. +Admitted. + +Global Instance trunc_trunc `{Funext} A m n : IsTrunc (trunc_S n) (IsTrunc m A) | 0. +Admitted. + +Definition BiInv {A B} (f : A -> B) : Type +:= ( {g : B -> A & forall x, g (f x) = x} * {h : B -> A & forall x, f (h x) = x}). + +Global Instance isprop_biinv {A B} (f : A -> B) : IsTrunc (trunc_S minus_two) (BiInv f) | 0. +Admitted. + +Instance isequiv_path {A B : Type} (p : A = B) +: IsEquiv (transport (fun X:Type => X) p) | 0. +Admitted. + +Class ReflectiveSubuniverse_internal := + { inO_internal : Type -> Type ; + O : Type -> Type ; + O_unit : forall T, T -> O T }. + +Class ReflectiveSubuniverse := + ReflectiveSubuniverse_wrap : Funext -> ReflectiveSubuniverse_internal. +Global Existing Instance ReflectiveSubuniverse_wrap. + +Class inO {fs : Funext} {subU : ReflectiveSubuniverse} (T : Type) := + isequiv_inO : inO_internal T. + +Global Instance hprop_inO {fs : Funext} {subU : ReflectiveSubuniverse} (T : Type) : IsTrunc (trunc_S minus_two) (inO T) . +Admitted. + +(* To avoid looping class resolution *) +Hint Mode IsEquiv - - + : typeclass_instances. + +Fail Definition equiv_O_rectnd {fs : Funext} {subU : ReflectiveSubuniverse} + (P Q : Type) {Q_inO : inO_internal Q} +: IsEquiv (fun f : O P -> P => compose f (O_unit P)) := _. diff --git a/test-suite/bugs/closed/bug_3623.v b/test-suite/bugs/closed/bug_3623.v new file mode 100644 index 0000000000..202b900164 --- /dev/null +++ b/test-suite/bugs/closed/bug_3623.v @@ -0,0 +1,4 @@ +Require Import List. +Goal (1 :: 2 :: nil) ++ (3::nil) = (1::2::3::nil). +change (@app nat (?a :: ?b) ?c) with (a :: @app nat b c). +Abort. diff --git a/test-suite/bugs/closed/bug_3624.v b/test-suite/bugs/closed/bug_3624.v new file mode 100644 index 0000000000..024243cfd3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3624.v @@ -0,0 +1,11 @@ +Set Implicit Arguments. +Module NonPrim. + Class foo (m : Set) := { pf : m = m }. + Notation pf' m := (pf (m := m)). +End NonPrim. + +Module Prim. + Set Primitive Projections. + Class foo (m : Set) := { pf : m = m }. + Notation pf' m := (pf (m:=m)). (* Wrong argument name: m. *) +End Prim. diff --git a/test-suite/bugs/closed/bug_3625.v b/test-suite/bugs/closed/bug_3625.v new file mode 100644 index 0000000000..d4b2cc5ccc --- /dev/null +++ b/test-suite/bugs/closed/bug_3625.v @@ -0,0 +1,12 @@ +Require Import TestSuite.admit. +Set Implicit Arguments. +Set Primitive Projections. +Record prod A B := pair { fst : A ; snd : B }. + +Goal forall x y : prod Set Set, x.(@fst _ _) = y.(@fst _ _). + intros. + refine (f_equal _ _). + Undo. + apply f_equal. + admit. +Qed. diff --git a/test-suite/bugs/closed/bug_3628.v b/test-suite/bugs/closed/bug_3628.v new file mode 100644 index 0000000000..4001cf7c2b --- /dev/null +++ b/test-suite/bugs/closed/bug_3628.v @@ -0,0 +1,9 @@ +Module NonPrim. + Class AClass := { x : Set }. + Arguments x {AClass}. +End NonPrim. +Module Prim. + Set Primitive Projections. + Class AClass := { x : Set }. + Arguments x {AClass}. +End Prim. diff --git a/test-suite/bugs/closed/bug_3633.v b/test-suite/bugs/closed/bug_3633.v new file mode 100644 index 0000000000..7a82a2685e --- /dev/null +++ b/test-suite/bugs/closed/bug_3633.v @@ -0,0 +1,10 @@ +Set Typeclasses Strict Resolution. +Class Contr (A : Type) := { center : A }. +Definition foo {A} `{Contr A} : A. +Proof. + apply center. + Undo. + (* Ensure the constraints are solved independently, otherwise a frozen ?A + makes a search for Contr ?A fail when finishing to apply (fun x => x) *) + apply (fun x => x), center. +Qed. diff --git a/test-suite/bugs/closed/bug_3637.v b/test-suite/bugs/closed/bug_3637.v new file mode 100644 index 0000000000..868f45c89a --- /dev/null +++ b/test-suite/bugs/closed/bug_3637.v @@ -0,0 +1,11 @@ + +Set Implicit Arguments. +Set Primitive Projections. +Record prod A B := pair { fst : A ; snd : B }. +Goal forall x y : prod Set Set, fst x = fst y. + intros. + lazymatch goal with + | [ |- context[@fst ?A ?B] ] => pose (@fst A B) as fst'; + progress change (@fst Set Set) with fst' +end. +Abort. diff --git a/test-suite/bugs/closed/bug_3638.v b/test-suite/bugs/closed/bug_3638.v new file mode 100644 index 0000000000..4f1fcfecd3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3638.v @@ -0,0 +1,25 @@ +(* File reduced by coq-bug-finder from original input, then from 7593 lines to 243 lines, then from 256 lines to 102 lines, then from 104 lines to 28 lines *) +(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) +Set Primitive Projections. +Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Class UnitSubuniverse := { O : Type -> Type ; O_unit : forall T, T -> O T }. +Class ReflectiveSubuniverse := { rsubu_usubu : UnitSubuniverse ; O_rectnd : forall {P Q : Type} (f : P -> Q), O P -> Q }. +Global Existing Instance rsubu_usubu. +Context {subU : ReflectiveSubuniverse}. +Goal forall (A B : Type) (x : O A * O B) (x0 : B), + { g : _ & O_rectnd (fun z : A * B => (O_unit (fst z), O_unit (snd z))) + (O_rectnd (fun a : A => O_unit (a, x0)) (fst x)) = + g x0 }. + eexists. + Show Existentials. Set Printing Existential Instances. + match goal with + | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in set (e' := e) + end. + + +(* Toplevel input, characters 15-114: +Anomaly: Bad recursive type. Please report. *) diff --git a/test-suite/bugs/closed/bug_3640.v b/test-suite/bugs/closed/bug_3640.v new file mode 100644 index 0000000000..5dff98ba23 --- /dev/null +++ b/test-suite/bugs/closed/bug_3640.v @@ -0,0 +1,31 @@ +(* File reduced by coq-bug-finder from original input, then from 14990 lines to 70 lines, then from 44 lines to 29 lines *) +(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) +Set Primitive Projections. +Set Implicit Arguments. +Record sigT {A} P := existT { pr1 : A ; pr2 : P pr1 }. +Notation "{ x : A & P }" := (sigT (A := A) (fun x : A => P)) : type_scope. +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'"). +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'"). +Record Equiv A B := { equiv_fun :> A -> B }. +Notation "A <~> B" := (Equiv A B) (at level 85). +Inductive Bool : Type := true | false. +Definition negb (b : Bool) := if b then false else true. +Axiom eval_bool_isequiv : forall (f : Bool -> Bool), f false = negb (f true). +Lemma bool_map_equiv_not_idmap (f : { f : Bool <~> Bool & ~(forall x, f x = x) }) +: forall b, ~(f.1 b = b). +Proof. + intro b. + intro H''. + apply f.2. + intro b'. + pose proof (eval_bool_isequiv f.1) as H. + destruct b', b. + Fail match type of H with + | _ = negb (f.1 true) => fail 1 "no f.1 true" + end. (* Error: No matching clauses for match. *) + destruct (f.1 true). + simpl in *. + Fail match type of H with + | _ = negb ?T => unify T (f.1 true); fail 1 "still has f.1 true" + end. (* Error: Tactic failure: still has f.1 true. *) diff --git a/test-suite/bugs/closed/bug_3641.v b/test-suite/bugs/closed/bug_3641.v new file mode 100644 index 0000000000..730ab3f431 --- /dev/null +++ b/test-suite/bugs/closed/bug_3641.v @@ -0,0 +1,21 @@ +(* File reduced by coq-bug-finder from original input, then from 7593 lines to 243 lines, then from 256 lines to 102 lines, then from\ + 104 lines to 28 lines *) +(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) +Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Class UnitSubuniverse := { O : Type -> Type ; O_unit : forall T, T -> O T }. +Class ReflectiveSubuniverse := { rsubu_usubu : UnitSubuniverse ; O_rectnd : forall {P Q : Type} (f : P -> Q), O P -> Q }. +Global Existing Instance rsubu_usubu. +Context {subU : ReflectiveSubuniverse}. +Goal forall (A B : Type) (x : O A * O B) (x0 : B), + { g : _ & O_rectnd (fun z : A * B => (O_unit (fst z), O_unit (snd z))) + (O_rectnd (fun a : A => O_unit (a, x0)) (fst x)) = + g x0 }. + eexists. + match goal with + | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in pose (e' := e) + end. + Fail change ?g with e'. (* Stack overflow *) diff --git a/test-suite/bugs/closed/bug_3647.v b/test-suite/bugs/closed/bug_3647.v new file mode 100644 index 0000000000..e91c004c77 --- /dev/null +++ b/test-suite/bugs/closed/bug_3647.v @@ -0,0 +1,654 @@ +Require Import TestSuite.admit. +Require Coq.Setoids.Setoid. + +Axiom BITS : nat -> Set. +Definition n7 := 7. +Definition n15 := 15. +Definition n31 := 31. +Notation n8 := (S n7). +Notation n16 := (S n15). +Notation n32 := (S n31). +Inductive OpSize := OpSize1 | OpSize2 | OpSize4 . +Definition VWORD s := BITS (match s with OpSize1 => n8 | OpSize2 => n16 | OpSize4 => n32 end). +Definition BYTE := VWORD OpSize1. +Definition WORD := VWORD OpSize2. +Definition DWORD := VWORD OpSize4. +Ltac subst_body := + repeat match goal with + | [ H := _ |- _ ] => subst H + end. +Import Coq.Setoids.Setoid. +Class Equiv (A : Type) := equiv : relation A. +Infix "===" := equiv (at level 70, no associativity). +Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. +Definition setoid_resp {T T'} (f : T -> T') `{e : type T} `{e' : type T'} := forall x y, x === y -> f x === f y. +Record morphism T T' `{e : type T} `{e' : type T'} := + mkMorph { + morph :> T -> T'; + morph_resp : setoid_resp morph}. +Arguments mkMorph [T T' e0 e e1 e']. +Infix "-s>" := morphism (at level 45, right associativity). +Section Morphisms. + Context {S T U V} `{eS : type S} `{eT : type T} `{eU : type U} `{eV : type V}. + Global Instance morph_equiv : Equiv (S -s> T). + admit. + Defined. + + Global Instance morph_type : type (S -s> T). + admit. + Defined. + + Program Definition mcomp (f: T -s> U) (g: S -s> T) : (S -s> U) := + mkMorph (fun x => f (g x)) _. + Next Obligation. + admit. + Defined. + +End Morphisms. + +Infix "<<" := mcomp (at level 35). + +Section MorphConsts. + Context {S T U V} `{eS : type S} `{eT : type T} `{eU : type U} `{eV : type V}. + + Definition lift2s (f : S -> T -> U) p q : (S -s> T -s> U) := + mkMorph (fun x => mkMorph (f x) (p x)) q. + +End MorphConsts. +Instance Equiv_PropP : Equiv Prop. +admit. +Defined. + +Section SetoidProducts. + Context {A B : Type} `{eA : type A} `{eB : type B}. + Global Instance Equiv_prod : Equiv (A * B). + admit. + Defined. + + Global Instance type_prod : type (A * B). + admit. + Defined. + + Program Definition mfst : (A * B) -s> A := + mkMorph (fun p => fst p) _. + Next Obligation. + admit. + Defined. + + Program Definition msnd : (A * B) -s> B := + mkMorph (fun p => snd p) _. + Next Obligation. + admit. + Defined. + + Context {C} `{eC : type C}. + + Program Definition mprod (f: C -s> A) (g: C -s> B) : C -s> (A * B) := + mkMorph (fun c => (f c, g c)) _. + Next Obligation. + admit. + Defined. + +End SetoidProducts. + +Section IndexedProducts. + + Record ttyp := {carr :> Type; eqc : Equiv carr; eqok : type carr}. + Global Instance ttyp_proj_eq {A : ttyp} : Equiv A. + admit. + Defined. + Global Instance ttyp_proj_prop {A : ttyp} : type A. + admit. + Defined. + Context {I : Type} {P : I -> ttyp}. + + Global Program Instance Equiv_prodI : Equiv (forall i, P i) := + fun p p' : forall i, P i => (forall i : I, @equiv _ (eqc _) (p i) (p' i)). + + Global Instance type_prodI : type (forall i, P i). + admit. + Defined. + + Program Definition mprojI (i : I) : (forall i, P i) -s> P i := + mkMorph (fun X => X i) _. + Next Obligation. + admit. + Defined. + + Context {C : Type} `{eC : type C}. + + Program Definition mprodI (f : forall i, C -s> P i) : C -s> (forall i, P i) := + mkMorph (fun c i => f i c) _. + Next Obligation. + admit. + Defined. + +End IndexedProducts. + +Section Exponentials. + + Context {A B C D} `{eA : type A} `{eB : type B} `{eC : type C} `{eD : type D}. + + Program Definition comps : (B -s> C) -s> (A -s> B) -s> A -s> C := + lift2s (fun f g => f << g) _ _. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + + Program Definition muncurry (f : A -s> B -s> C) : A * B -s> C := + mkMorph (fun p => f (fst p) (snd p)) _. + Next Obligation. + admit. + Defined. + + Program Definition mcurry (f : A * B -s> C) : A -s> B -s> C := + lift2s (fun a b => f (a, b)) _ _. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + + Program Definition meval : (B -s> A) * B -s> A := + mkMorph (fun p => fst p (snd p)) _. + Next Obligation. + admit. + Defined. + + Program Definition mid : A -s> A := mkMorph (fun x => x) _. + Next Obligation. + admit. + Defined. + + Program Definition mconst (b : B) : A -s> B := mkMorph (fun _ => b) _. + Next Obligation. + admit. + Defined. + +End Exponentials. + +Inductive empty : Set := . +Instance empty_Equiv : Equiv empty. +admit. +Defined. +Instance empty_type : type empty. +admit. +Defined. + +Section Initials. + Context {A} `{eA : type A}. + + Program Definition mzero_init : empty -s> A := mkMorph (fun x => match x with end) _. + Next Obligation. + admit. + Defined. + +End Initials. + +Section Subsetoid. + + Context {A} `{eA : type A} {P : A -> Prop}. + Global Instance subset_Equiv : Equiv {a : A | P a}. + admit. + Defined. + Global Instance subset_type : type {a : A | P a}. + admit. + Defined. + + Program Definition mforget : {a : A | P a} -s> A := + mkMorph (fun x => x) _. + Next Obligation. + admit. + Defined. + + Context {B} `{eB : type B}. + Program Definition minherit (f : B -s> A) (HB : forall b, P (f b)) : B -s> {a : A | P a} := + mkMorph (fun b => exist P (f b) (HB b)) _. + Next Obligation. + admit. + Defined. + +End Subsetoid. + +Section Option. + + Context {A} `{eA : type A}. + Global Instance option_Equiv : Equiv (option A). + admit. + Defined. + + Global Instance option_type : type (option A). + admit. + Defined. + +End Option. + +Section OptDefs. + Context {A B} `{eA : type A} `{eB : type B}. + + Program Definition msome : A -s> option A := mkMorph (fun a => Some a) _. + Next Obligation. + admit. + Defined. + + Program Definition moptionbind (f : A -s> option B) : option A -s> option B := + mkMorph (fun oa => match oa with None => None | Some a => f a end) _. + Next Obligation. + admit. + Defined. + +End OptDefs. + +Generalizable Variables Frm. + +Class ILogicOps Frm := { + lentails: relation Frm; + ltrue: Frm; + lfalse: Frm; + limpl: Frm -> Frm -> Frm; + land: Frm -> Frm -> Frm; + lor: Frm -> Frm -> Frm; + lforall: forall {T}, (T -> Frm) -> Frm; + lexists: forall {T}, (T -> Frm) -> Frm + }. + +Infix "|--" := lentails (at level 79, no associativity). +Infix "//\\" := land (at level 75, right associativity). +Infix "\\//" := lor (at level 76, right associativity). +Infix "-->>" := limpl (at level 77, right associativity). +Notation "'Forall' x .. y , p" := + (lforall (fun x => .. (lforall (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity). +Notation "'Exists' x .. y , p" := + (lexists (fun x => .. (lexists (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity). + +Class ILogic Frm {ILOps: ILogicOps Frm} := { + lentailsPre:> PreOrder lentails; + ltrueR: forall C, C |-- ltrue; + lfalseL: forall C, lfalse |-- C; + lforallL: forall T x (P: T -> Frm) C, P x |-- C -> lforall P |-- C; + lforallR: forall T (P: T -> Frm) C, (forall x, C |-- P x) -> C |-- lforall P; + lexistsL: forall T (P: T -> Frm) C, (forall x, P x |-- C) -> lexists P |-- C; + lexistsR: forall T x (P: T -> Frm) C, C |-- P x -> C |-- lexists P; + landL1: forall P Q C, P |-- C -> P //\\ Q |-- C; + landL2: forall P Q C, Q |-- C -> P //\\ Q |-- C; + lorR1: forall P Q C, C |-- P -> C |-- P \\// Q; + lorR2: forall P Q C, C |-- Q -> C |-- P \\// Q; + landR: forall P Q C, C |-- P -> C |-- Q -> C |-- P //\\ Q; + lorL: forall P Q C, P |-- C -> Q |-- C -> P \\// Q |-- C; + landAdj: forall P Q C, C |-- (P -->> Q) -> C //\\ P |-- Q; + limplAdj: forall P Q C, C //\\ P |-- Q -> C |-- (P -->> Q) + }. +Hint Extern 0 (?x |-- ?x) => reflexivity. + +Section ILogicExtra. + Context `{IL: ILogic Frm}. + Definition lpropand (p: Prop) Q := Exists _: p, Q. + Definition lpropimpl (p: Prop) Q := Forall _: p, Q. + +End ILogicExtra. + +Infix "/\\" := lpropand (at level 75, right associativity). +Infix "->>" := lpropimpl (at level 77, right associativity). + +Section ILogic_Fun. + Context (T: Type) `{TType: type T}. + Context `{IL: ILogic Frm}. + + Record ILFunFrm := mkILFunFrm { + ILFunFrm_pred :> T -> Frm; + ILFunFrm_closed: forall t t': T, t === t' -> + ILFunFrm_pred t |-- ILFunFrm_pred t' + }. + + Notation "'mk'" := @mkILFunFrm. + + Program Definition ILFun_Ops : ILogicOps ILFunFrm := {| + lentails P Q := forall t:T, P t |-- Q t; + ltrue := mk (fun t => ltrue) _; + lfalse := mk (fun t => lfalse) _; + limpl P Q := mk (fun t => P t -->> Q t) _; + land P Q := mk (fun t => P t //\\ Q t) _; + lor P Q := mk (fun t => P t \\// Q t) _; + lforall A P := mk (fun t => Forall a, P a t) _; + lexists A P := mk (fun t => Exists a, P a t) _ + |}. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + +End ILogic_Fun. + +Arguments ILFunFrm _ {e} _ {ILOps}. +Arguments mkILFunFrm [T] _ [Frm ILOps]. + +Program Definition ILFun_eq {T R} {ILOps: ILogicOps R} {ILogic: ILogic R} (P : T -> R) : + @ILFunFrm T _ R ILOps := + @mkILFunFrm T eq R ILOps P _. +Next Obligation. + admit. +Defined. + +Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| + lentails P Q := (P : Prop) -> Q; + ltrue := True; + lfalse := False; + limpl P Q := P -> Q; + land P Q := P /\ Q; + lor P Q := P \/ Q; + lforall T F := forall x:T, F x; + lexists T F := exists x:T, F x + |}. + +Instance ILogic_Prop : ILogic Prop. +admit. +Defined. + +Section FunEq. + Context A `{eT: type A}. + + Global Instance FunEquiv {T} : Equiv (T -> A) := { + equiv P Q := forall a, P a === Q a + }. +End FunEq. + +Section SepAlgSect. + Class SepAlgOps T `{eT : type T}:= { + sa_unit : T; + + sa_mul : T -> T -> T -> Prop + }. + + Class SepAlg T `{SAOps: SepAlgOps T} : Type := { + sa_mul_eqL a b c d : sa_mul a b c -> c === d -> sa_mul a b d; + sa_mul_eqR a b c d : sa_mul a b c -> sa_mul a b d -> c === d; + sa_mon a b c : a === b -> sa_mul a c === sa_mul b c; + sa_mulC a b : sa_mul a b === sa_mul b a; + sa_mulA a b c : forall bc abc, sa_mul a bc abc -> sa_mul b c bc -> + exists ac, sa_mul b ac abc /\ sa_mul a c ac; + sa_unitI a : sa_mul a sa_unit a + }. + +End SepAlgSect. + +Section BILogic. + + Class BILOperators (A : Type) := { + empSP : A; + sepSP : A -> A -> A; + wandSP : A -> A -> A + }. + +End BILogic. + +Notation "a '**' b" := (sepSP a b) + (at level 75, right associativity). + +Section BISepAlg. + Context {A} `{sa : SepAlg A}. + Context {B} `{IL: ILogic B}. + + Program Instance SABIOps: BILOperators (ILFunFrm A B) := { + empSP := mkILFunFrm e (fun x => sa_unit === x /\\ ltrue) _; + sepSP P Q := mkILFunFrm e (fun x => Exists x1, Exists x2, sa_mul x1 x2 x /\\ + P x1 //\\ Q x2) _; + wandSP P Q := mkILFunFrm e (fun x => Forall x1, Forall x2, sa_mul x x1 x2 ->> + P x1 -->> Q x2) _ + }. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + +End BISepAlg. + +Set Implicit Arguments. + +Definition Chan := WORD. +Definition Data := BYTE. + +Inductive Action := +| Out (c:Chan) (d:Data) +| In (c:Chan) (d:Data). + +Definition Actions := list Action. + +Instance ActionsEquiv : Equiv Actions := { + equiv a1 a2 := a1 = a2 + }. + +Definition OPred := ILFunFrm Actions Prop. +Definition mkOPred (P : Actions -> Prop) : OPred. + admit. +Defined. + +Definition eq_opred s := mkOPred (fun s' => s === s'). +Definition empOP : OPred. + exact (eq_opred nil). +Defined. +Definition catOP (P Q: OPred) : OPred. + admit. +Defined. + +Class IsPointed (T : Type) := point : T. + +Generalizable All Variables. + +Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). + +Record PointedOPred := mkPointedOPred { + OPred_pred :> OPred; + OPred_inhabited: IsPointed_OPred OPred_pred + }. + +Existing Instance OPred_inhabited. + +Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred + := {| OPred_pred := O ; OPred_inhabited := _ |}. +Instance IsPointed_eq_opred x : IsPointed_OPred (eq_opred x). +admit. +Defined. +Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q). +admit. +Defined. + +Definition Flag := BITS 5. +Definition OF: Flag. + admit. +Defined. + +Inductive FlagVal := mkFlag (b: bool) | FlagUnspecified. +Coercion mkFlag : bool >-> FlagVal. +Inductive NonSPReg := EAX | EBX | ECX | EDX | ESI | EDI | EBP. + +Inductive Reg := nonSPReg (r: NonSPReg) | ESP. + +Inductive AnyReg := regToAnyReg (r: Reg) | EIP. + +Inductive BYTEReg := AL|BL|CL|DL|AH|BH|CH|DH. + +Inductive WORDReg := mkWordReg (r:Reg). +Definition PState : Type. +admit. +Defined. + +Instance PStateEquiv : Equiv PState. +admit. +Defined. + +Instance PStateType : type PState. +admit. +Defined. + +Instance PStateSepAlgOps: SepAlgOps PState. +admit. +Defined. +Definition SPred : Type. +exact (ILFunFrm PState Prop). +Defined. + +Local Existing Instance ILFun_Ops. +Local Existing Instance SABIOps. +Axiom BYTEregIs : BYTEReg -> BYTE -> SPred. + +Inductive RegOrFlag := +| RegOrFlagDWORD :> AnyReg -> RegOrFlag +| RegOrFlagWORD :> WORDReg -> RegOrFlag +| RegOrFlagBYTE :> BYTEReg -> RegOrFlag +| RegOrFlagF :> Flag -> RegOrFlag. + +Definition RegOrFlag_target rf := + match rf with + | RegOrFlagDWORD _ => DWORD + | RegOrFlagWORD _ => WORD + | RegOrFlagBYTE _ => BYTE + | RegOrFlagF _ => FlagVal + end. + +Inductive Condition := +| CC_O | CC_B | CC_Z | CC_BE | CC_S | CC_P | CC_L | CC_LE. + +Section ILSpecSect. + + Axiom spec : Type. + Global Instance ILOps: ILogicOps spec | 2. + admit. + Defined. + +End ILSpecSect. + +Axiom parameterized_basic : forall {T_OPred} {proj : T_OPred -> OPred} {T} (P : SPred) (c : T) (O : OPred) (Q : SPred), spec. +Global Notation loopy_basic := (@parameterized_basic PointedOPred OPred_pred _). + +Axiom program : Type. + +Axiom ConditionIs : forall (cc : Condition) (cv : RegOrFlag_target OF), SPred. + +Axiom foldl : forall {T R}, (R -> T -> R) -> R -> list T -> R. +Axiom nth : forall {T}, T -> list T -> nat -> T. +Axiom while : forall (ptest: program) + (cond: Condition) (value: bool) + (pbody: program), program. + +Lemma while_rule_ind {quantT} + {ptest} {cond : Condition} {value : bool} {pbody} + {S} + {transition_body : quantT -> quantT} + {P : quantT -> SPred} {Otest : quantT -> OPred} {Obody : quantT -> OPred} {O : quantT -> PointedOPred} + {O_after_test : quantT -> PointedOPred} + {I_state : quantT -> bool -> SPred} + {I_logic : quantT -> bool -> bool} + {Q : quantT -> SPred} + (Htest : S |-- (Forall (x : quantT), + (loopy_basic (P x) + ptest + (Otest x) + (Exists b, I_logic x b = true /\\ I_state x b ** ConditionIs cond b)))) + (Hbody : S |-- (Forall (x : quantT), + (loopy_basic (I_logic x value = true /\\ I_state x value ** ConditionIs cond value) + pbody + (Obody x) + (P (transition_body x))))) + (H_after_test : forall x, catOP (Otest x) (O_after_test x) |-- O x) + (H_body_after_test : forall x, I_logic x value = true -> catOP (Obody x) (O (transition_body x)) |-- O_after_test x) + (H_empty : forall x, I_logic x (negb value) = true -> empOP |-- O_after_test x) + (Q_correct : forall x, I_logic x (negb value) = true /\\ I_state x (negb value) ** ConditionIs cond (negb value) |-- Q x) + (Q_safe : forall x, I_logic x value = true -> Q (transition_body x) |-- Q x) +: S |-- (Forall (x : quantT), + loopy_basic (P x) + (while ptest cond value pbody) + (O x) + (Q x)). +admit. +Defined. +Axiom behead : forall {T}, list T -> list T. +Axiom all : forall {T}, (T -> bool) -> list T -> bool. +Axiom all_behead : forall {T} (xs : list T) P, all P xs = true -> all P (behead xs) = true. +Instance IsPointed_foldlOP A B C f g (init : A * B) `{IsPointed_OPred (g init)} + `{forall a acc, IsPointed_OPred (g acc) -> IsPointed_OPred (g (f acc a))} + (ls : list C) +: IsPointed_OPred (g (foldl f init ls)). +admit. +Defined. +Goal forall (ptest : program) (cond : Condition) (value : bool) + (pbody : program) (T ioT : Type) (P : T -> SPred) + (I : T -> bool -> SPred) (accumulate : T -> ioT -> T) + (Otest Obody : T -> ioT -> PointedOPred) + (coq_test__is_finished : ioT -> bool) (S : spec) + (al : BYTE), + (forall (initial : T) (xs : list ioT) (x : ioT), + all (fun t : ioT => negb (coq_test__is_finished t)) xs = true -> + coq_test__is_finished x = true -> + S + |-- loopy_basic (P initial ** BYTEregIs AL al) ptest + (Otest initial (nth x xs 0)) + (I initial + (match coq_test__is_finished (nth x xs 0) with true => negb value | false => value end) ** + ConditionIs cond + (match coq_test__is_finished (nth x xs 0) with true => negb value | false => value end))) -> + (forall (initial : T) (xs : list ioT) (x : ioT), + all (fun t : ioT => negb (coq_test__is_finished t)) xs = true -> + xs <> nil -> + coq_test__is_finished x = true -> + S + |-- loopy_basic (I initial value ** ConditionIs cond value) pbody + (Obody initial (nth x xs 0)) + (P (accumulate initial (nth x xs 0)) ** BYTEregIs AL al)) -> + forall x : ioT, + coq_test__is_finished x = true -> + S + |-- Forall ixsp : {init_xs : T * list ioT & + all (fun t : ioT => negb (coq_test__is_finished t)) + (snd init_xs) = true}, + loopy_basic (P (fst (projT1 ixsp)) ** BYTEregIs AL al) + (while ptest cond value pbody) + (catOP + (snd + (foldl + (fun (xy : T * OPred) (v : ioT) => + (accumulate (fst xy) v, + catOP (catOP (Otest (fst xy) v) (Obody (fst xy) v)) + (snd xy))) (fst (projT1 ixsp), empOP) + (snd (projT1 ixsp)))) + (Otest (foldl accumulate (fst (projT1 ixsp)) (snd (projT1 ixsp))) + x)) + (I (foldl accumulate (fst (projT1 ixsp)) (snd (projT1 ixsp))) + (negb value) ** ConditionIs cond (negb value)). + intros. + eapply @while_rule_ind + with (I_logic := fun ixsp b => match (match (coq_test__is_finished (nth x (snd (projT1 ixsp)) 0)) with true => negb value | false => value end), b with true, true => true | false, false => true | _, _ => false end) + (Otest := fun ixsp => Otest (fst (projT1 ixsp)) (nth x (snd (projT1 ixsp)) 0)) + (Obody := fun ixsp => Obody (fst (projT1 ixsp)) (nth x (snd (projT1 ixsp)) 0)) + (I_state := fun ixsp => I (fst (projT1 ixsp))) + (transition_body := fun ixsp => let initial := fst (projT1 ixsp) in + let xs := snd (projT1 ixsp) in + existT _ (accumulate initial (nth x xs 0), behead xs) _) + (O_after_test := fun ixsp => let initial := fst (projT1 ixsp) in + let xs := snd (projT1 ixsp) in + match xs with | nil => default_PointedOPred empOP | _ => Obody initial (nth x xs 0) end); + simpl projT1; simpl projT2; simpl fst; simpl snd; clear; let H := fresh in assert (H : False) by (clear; admit); destruct H. + + Grab Existential Variables. + subst_body; simpl. + Fail refine (all_behead (projT2 _)). + Unset Solve Unification Constraints. refine (all_behead (projT2 _)). diff --git a/test-suite/bugs/closed/bug_3648.v b/test-suite/bugs/closed/bug_3648.v new file mode 100644 index 0000000000..58aa161403 --- /dev/null +++ b/test-suite/bugs/closed/bug_3648.v @@ -0,0 +1,83 @@ +(* File reduced by coq-bug-finder from original input, then from 8808 lines to 424 lines, then from 432 lines to 196 lines, then from\ + 145 lines to 82 lines *) +(* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *) + +Reserved Infix "o" (at level 40, left associativity). +Global Set Primitive Projections. + +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. + +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g) + }. +Arguments identity {!C%category} / x%object : rename. + +Infix "o" := (@compose _ _ _ _) : morphism_scope. + +Local Open Scope morphism_scope. +Definition prodC (C D : PreCategory) : PreCategory. + refine (@Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) + * morphism D (snd s) (snd d))%type) + (fun x => (identity (fst x), identity (snd x))) + (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1))). +Defined. + +Local Infix "*" := prodC : category_scope. + +Delimit Scope functor_scope with functor. + +Record Functor (C D : PreCategory) := + { + object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d); + identity_of : forall x, morphism_of _ _ (identity x) + = identity (object_of x) + }. +Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. +Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. +Axiom cheat : forall {A}, A. +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. +Definition functor_category (C D : PreCategory) : PreCategory. + exact (@Build_PreCategory (Functor C D) + (@NaturalTransformation C D) cheat cheat). +Defined. + +Local Notation "C -> D" := (functor_category C D) : category_scope. +Variable C1 : PreCategory. +Variable C2 : PreCategory. +Variable D : PreCategory. + +Definition functor_object_of +: (C1 -> (C2 -> D))%category -> (C1 * C2 -> D)%category. +Proof. + intro F; hnf in F |- *. + refine (Build_Functor + (prodC C1 C2) D + (fun c1c2 => F (fst c1c2) (snd c1c2)) + (fun s d m => F (fst d) _1 (snd m) o (@morphism_of _ _ F _ _ (fst m)) (snd s)) + _). + intros. + rewrite identity_of. + cbn. + rewrite (identity_of _ _ F (fst x)). + Undo. +(* Toplevel input, characters 20-55: +Error: +Found no subterm matching "F _1 (identity (fst x))" in the current goal. *) + rewrite identity_of. (* Toplevel input, characters 15-34: +Error: +Found no subterm matching "morphism_of ?202 (identity ?203)" in the current goal. *) diff --git a/test-suite/bugs/closed/bug_3649.v b/test-suite/bugs/closed/bug_3649.v new file mode 100644 index 0000000000..a664a1ef1d --- /dev/null +++ b/test-suite/bugs/closed/bug_3649.v @@ -0,0 +1,60 @@ +(* -*- coq-prog-args: ("-nois") -*- *) +(* File reduced by coq-bug-finder from original input, then from 9518 lines to 404 lines, then from 410 lines to 208 lines, then from 162 lines to 77 lines *) +(* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *) +Declare ML Module "ltac_plugin". +Set Default Proof Mode "Classic". +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Reserved Notation "x = y" (at level 70, no associativity). +Delimit Scope type_scope with type. +Bind Scope type_scope with Sortclass. +Open Scope type_scope. +Axiom admit : forall {T}, T. +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Reserved Infix "o" (at level 40, left associativity). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Global Set Primitive Projections. +Delimit Scope morphism_scope with morphism. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g) }. +Infix "o" := (@compose _ _ _ _) : morphism_scope. +Set Implicit Arguments. +Local Open Scope morphism_scope. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d) }. +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := + { morphism_inverse : morphism C d s }. +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. +Definition composeT C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F') +: NaturalTransformation F F''. + exact admit. +Defined. +Definition functor_category (C D : PreCategory) : PreCategory. + exact (@Build_PreCategory (Functor C D) + (@NaturalTransformation C D) + admit + (@composeT C D)). +Defined. +Goal forall (C D : PreCategory) (G G' : Functor C D) + (T : @NaturalTransformation C D G G') + (H : @IsIsomorphism (@functor_category C D) G G' T) + (x : C), + @paths (morphism D (G x) (G x)) + (@compose D (G x) (G' x) (G x) + ((@morphism_inverse (@functor_category C D) G G' T H) x) + (T x)) (@identity D (G x)). + intros. + (** This [change] succeeded, but did not progress, in 07e4438bd758c2ced8caf09a6961ccd77d84e42b, because [T0 x o T1 x] was not found in the goal *) + let T0 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T0) end in + let T1 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T1) end in + progress change (T0 x o T1 x) with ((fun y => y) (T0 x o T1 x)). diff --git a/test-suite/bugs/closed/bug_3652.v b/test-suite/bugs/closed/bug_3652.v new file mode 100644 index 0000000000..915cfcac27 --- /dev/null +++ b/test-suite/bugs/closed/bug_3652.v @@ -0,0 +1,100 @@ +Require Setoid. +Require ZArith. +Import ZArith. + +Inductive Erasable(A : Set) : Prop := + erasable: A -> Erasable A. + +Arguments erasable [A] _. + +Hint Constructors Erasable. + +Scheme Erasable_elim := Induction for Erasable Sort Prop. + +Notation "## T" := (Erasable T) (at level 1, format "## T") : Erasable_scope. +Notation "# x" := (erasable x) (at level 1, format "# x") : Erasable_scope. +Open Scope Erasable_scope. + +Axiom Erasable_inj : forall {A : Set}{a b : A}, #a=#b -> a=b. + +Lemma Erasable_rw : forall (A: Set)(a b : A), (#a=#b) <-> (a=b). +Proof. + intros A a b. + split. + - apply Erasable_inj. + - congruence. +Qed. + +Open Scope Z_scope. +Opaque Z.mul. + +Infix "^" := Zpower_nat : Z_scope. + +Notation "f ; v <- x" := (let (v) := x in f) + (at level 199, left associativity) : Erasable_scope. +Notation "f ; < v" := (f ; v <- v) + (at level 199, left associativity) : Erasable_scope. +Notation "f |# v <- x" := (#f ; v <- x) + (at level 199, left associativity) : Erasable_scope. +Notation "f |# < v" := (#f ; < v) + (at level 199, left associativity) : Erasable_scope. + +Ltac name_evars id := + repeat match goal with |- context[?V] => + is_evar V; let H := fresh id in set (H:=V) in * end. + +Lemma Twoto0 : 2^0 = 1. +Proof. compute. reflexivity. Qed. + +Ltac ring_simplify' := rewrite ?Twoto0; ring_simplify. + +Definition mp2a1s(x : Z)(n : nat) := x * 2^n + (2^n-1). + +Hint Unfold mp2a1s. + +Definition zotval(n1s : nat)(is2 : bool)(next_value : Z) : Z := + 2 * mp2a1s next_value n1s + if is2 then 2 else 0. + +Inductive zot'(eis2 : ##bool)(value : ##Z) : Set := +| Zot'(is2 : bool) + (iseq : eis2=#is2) + {next_is2 : ##bool} + (ok : is2=true -> next_is2=#false) + {next_value : ##Z} + (n1s : nat) + (veq : value = (zotval n1s is2 next_value |# Prop. + +Lemma rule{T : Set}{x : T} : Q x <-> P x. admit. Qed. + +Goal forall (T : Set)(x : T), Q x <-> P x. +Proof. +intros T x. +setoid_rewrite rule. +reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_3654.v b/test-suite/bugs/closed/bug_3654.v new file mode 100644 index 0000000000..15277235b1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3654.v @@ -0,0 +1,7 @@ +Tactic Notation "mysimpl" "in" ne_hyp_list(hyps) := simpl in hyps. + +Goal 0+0=0->0+0=0->0=0. +intros H1 H2. +mysimpl in H1 H2. +match goal with H:0=0 |- _ => exact H end. +Qed. diff --git a/test-suite/bugs/closed/bug_3656.v b/test-suite/bugs/closed/bug_3656.v new file mode 100644 index 0000000000..fb92e11630 --- /dev/null +++ b/test-suite/bugs/closed/bug_3656.v @@ -0,0 +1,53 @@ +Module A. + Set Primitive Projections. + Record hSet : Type := BuildhSet { setT : Type; iss : True }. + Ltac head_hnf_under_binders x := + match eval hnf in x with + | ?f _ => head_hnf_under_binders f + | (fun y => ?f y) => head_hnf_under_binders f + | ?y => y + end. +Goal forall s : hSet, True. +intros. +let x := head_hnf_under_binders setT in pose x. + +set (foo := eq_refl (@setT )). generalize foo. simpl. cbn. +Abort. +End A. + +Module A'. +Set Universe Polymorphism. + Set Primitive Projections. +Record hSet (A : Type) : Type := BuildhSet { setT : Type; iss : True }. +Ltac head_hnf_under_binders x := + match eval compute in x with + | ?f _ => head_hnf_under_binders f + | (fun y => ?f y) => head_hnf_under_binders f + | ?y => y + end. +Goal forall s : @hSet nat, True. +intros. +let x := head_hnf_under_binders setT in pose x. + +set (foo := eq_refl (@setT nat)). generalize foo. simpl. cbn. +Abort. +End A'. + +Set Primitive Projections. +Record hSet : Type := BuildhSet { setT : Type; iss : True }. +Ltac head_hnf_under_binders x := + match eval hnf in x with + | ?f _ => head_hnf_under_binders f + | (fun y => ?f y) => head_hnf_under_binders f + | ?y => y + end. +Goal setT = setT. + progress unfold setT. (* should not succeed *) + match goal with + | |- (fun h => setT h) = (fun h => setT h) => fail 1 "should not eta-expand" + | _ => idtac + end. (* should not fail *) +Abort. + +Goal forall h, setT h = setT h. +Proof. intro. progress unfold setT. diff --git a/test-suite/bugs/closed/bug_3657.v b/test-suite/bugs/closed/bug_3657.v new file mode 100644 index 0000000000..778fdab190 --- /dev/null +++ b/test-suite/bugs/closed/bug_3657.v @@ -0,0 +1,12 @@ +(* Check typing of replaced objects in change - even though the failure + was already a proper error message (but with a helpless content) *) + +Class foo {A} {a : A} := { bar := a; baz : bar = bar }. +Arguments bar {_} _ {_}. +Instance: forall A a, @foo A a. +intros; constructor. +abstract reflexivity. +Defined. +Goal @bar _ Set _ = (@bar _ (fun _ : Set => Set) _) nat. +Proof. + Fail change (bar (fun _ : Set => Set)) with (bar Set). diff --git a/test-suite/bugs/closed/bug_3658.v b/test-suite/bugs/closed/bug_3658.v new file mode 100644 index 0000000000..74f4e82dbb --- /dev/null +++ b/test-suite/bugs/closed/bug_3658.v @@ -0,0 +1,75 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 12178 lines to 457 lines, then from 500 lines to 147 lines, then from 175 lines to 56 lines *) +(* coqc version trunk (September 2014) compiled on Sep 21 2014 16:34:4 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (eaf864354c3fda9ddc1f03f0b1c7807b6fd44322) *) + +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. +Module NonPrim. + Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center = y) }. + Arguments center A {_} / . + Inductive trunc_index : Type := minus_two | trunc_S (_ : trunc_index). + Notation "-2" := minus_two (at level 0). + Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | -2 => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. + Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. + Notation Contr := (IsTrunc -2). + Hint Extern 0 => progress change Contr_internal with Contr in * : typeclass_instances. + Goal forall (H : Type) (H0 : H -> H -> Type) (H1 : Type) + (H2 : Contr H1) (H3 : H1) (H4 : H1 -> H) + (H5 : H0 (H4 (center H1)) (H4 H3)) + (H6 : H0 (H4 (center H1)) (H4 (center H1))), + transport (fun y : H => H0 (H4 (center H1)) y) (ap H4 (contr H3)) H6 = H5. + intros. + match goal with + | [ |- context[contr (center _)] ] => fail 1 "bad" + | _ => idtac + end. + match goal with + | [ H : _ |- _ ] => destruct (contr H) + end. + match goal with + | [ |- context[contr (center ?x)] ] => fail 1 "bad" x + | _ => idtac + end. + admit. + Defined. +End NonPrim. + +Module Prim. + Set Primitive Projections. + Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center = y) }. + Arguments center A {_} / . + Inductive trunc_index : Type := minus_two | trunc_S (_ : trunc_index). + Notation "-2" := minus_two (at level 0). + Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | -2 => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. + Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. + Notation Contr := (IsTrunc -2). + Hint Extern 0 => progress change Contr_internal with Contr in * : typeclass_instances. + Goal forall (H : Type) (H0 : H -> H -> Type) (H1 : Type) + (H2 : Contr H1) (H3 : H1) (H4 : H1 -> H) + (H5 : H0 (H4 (center H1)) (H4 H3)) + (H6 : H0 (H4 (center H1)) (H4 (center H1))), + transport (fun y : H => H0 (H4 (center H1)) y) (ap H4 (contr H3)) H6 = H5. + intros. + match goal with + | [ |- context[contr (center _)] ] => fail 1 "bad" + | _ => idtac + end. + match goal with + | [ H : _ |- _ ] => destruct (contr H) + end. + match goal with + | [ |- context[contr (center ?x)] ] => fail 1 "bad" x + | _ => idtac + end. (* Error: Tactic failure: bad H1. *) + admit. + Defined. +End Prim. diff --git a/test-suite/bugs/closed/bug_3660.v b/test-suite/bugs/closed/bug_3660.v new file mode 100644 index 0000000000..be693886e6 --- /dev/null +++ b/test-suite/bugs/closed/bug_3660.v @@ -0,0 +1,28 @@ +Require Import TestSuite.admit. +Generalizable All Variables. +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. +Open Scope function_scope. +Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. +Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. +Axiom IsHSet : Type -> Type. +Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} : IsEquiv (compose g f) | 1000. +admit. +Defined. +Set Primitive Projections. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. +Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). +Global Instance isequiv_ap_setT X Y : IsEquiv (@ap _ _ setT X Y). +admit. +Defined. +Local Open Scope equiv_scope. +Axiom equiv_path : forall (A B : Type) (p : A = B), A <~> B. + +Goal forall (C D : hSet), IsEquiv (fun x : C = D => (equiv_path C D (ap setT x))). + intros. + change (IsEquiv (equiv_path C D o @ap _ _ setT C D)). + apply @isequiv_compose; [ | admit ]. + Set Typeclasses Debug. + typeclasses eauto. diff --git a/test-suite/bugs/closed/bug_3661.v b/test-suite/bugs/closed/bug_3661.v new file mode 100644 index 0000000000..1f13ffcf34 --- /dev/null +++ b/test-suite/bugs/closed/bug_3661.v @@ -0,0 +1,88 @@ +(* File reduced by coq-bug-finder from original input, then from 11218 lines to 438 lines, then from 434 lines to 202 lines, then from 140 lines to 94 lines *) +(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Set Implicit Arguments. +Delimit Scope morphism_scope with morphism. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Bind Scope category_scope with PreCategory. +Local Open Scope morphism_scope. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. +Set Primitive Projections. +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. +Unset Primitive Projections. +Class Isomorphic {C : PreCategory} s d := + { morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. +Arguments morphism_inverse {C s d} m {_} / . +Local Notation "m ^-1" := (morphism_inverse m) (at level 3, format "m '^-1'") : morphism_scope. +Definition functor_category (C D : PreCategory) : PreCategory. + exact (@Build_PreCategory (Functor C D) + (@NaturalTransformation C D)). +Defined. +Local Notation "C -> D" := (functor_category C D) : category_scope. +Generalizable All Variables. +Definition isisomorphism_components_of `{@IsIsomorphism (C -> D) F G T} x : IsIsomorphism (T x). +Proof. + constructor. + exact (T^-1 x). +Defined. +Hint Immediate isisomorphism_components_of : typeclass_instances. +Goal forall (x3 x9 : PreCategory) (x12 f0 : Functor x9 x3) + (x35 : @Isomorphic (@functor_category x9 x3) f0 x12) + (x37 : object x9) + (H3 : morphism x3 (@object_of x9 x3 f0 x37) + (@object_of x9 x3 f0 x37)) + (x34 : @Isomorphic (@functor_category x9 x3) x12 f0) + (m : morphism x3 (x12 x37) (f0 x37) -> + morphism x3 (f0 x37) (x12 x37) -> + morphism x3 (f0 x37) (f0 x37)), + @paths + (morphism x3 (@object_of x9 x3 f0 x37) (@object_of x9 x3 f0 x37)) + H3 + (m + (@components_of x9 x3 x12 f0 + (@morphism_inverse (@functor_category x9 x3) f0 x12 + (@morphism_isomorphic (@functor_category x9 x3) f0 x12 x35) + (@isisomorphism_isomorphic (@functor_category x9 x3) f0 x12 + x35)) x37) + (@components_of x9 x3 f0 x12 + (@morphism_inverse (@functor_category x9 x3) x12 f0 + (@morphism_isomorphic (@functor_category x9 x3) x12 f0 x34) + (@isisomorphism_isomorphic (@functor_category x9 x3) x12 f0 + x34)) x37)). + Unset Printing All. + intros. + match goal with + | [ |- context[components_of ?T^-1 ?x] ] + => progress let T1 := constr:(T^-1 x) in + let T2 := constr:((T x)^-1) in + change T1 with T2 || fail 1 "too early" + end. + + Undo. + + match goal with + | [ |- context[components_of ?T^-1 ?x] ] + => progress let T1 := constr:(T^-1 x) in + change T1 with ((T x)^-1) || fail 1 "too early 2" + end. + + Undo. + + match goal with + | [ |- context[components_of ?T^-1 ?x] ] + => progress let T2 := constr:((T x)^-1) in + change (T^-1 x) with T2 + end. (* not convertible *) + +(* + + (@components_of x9 x3 x12 f0 + (@morphism_inverse _ _ _ + (@morphism_isomorphic (functor_category x9 x3) f0 x12 x35) _) x37) + +*) diff --git a/test-suite/bugs/closed/bug_3662.v b/test-suite/bugs/closed/bug_3662.v new file mode 100644 index 0000000000..3f6d879bc0 --- /dev/null +++ b/test-suite/bugs/closed/bug_3662.v @@ -0,0 +1,46 @@ +Set Primitive Projections. +Set Implicit Arguments. +Set Nonrecursive Elimination Schemes. +Record prod A B := pair { fst : A ; snd : B }. +Definition f : Set -> Type := fun x => x. + +Goal (fst (pair (fun x => x + 1) nat) 0) = 0. +compute. +Undo. +cbv. +Undo. +Opaque fst. +cbn. +Transparent fst. +cbn. +Undo. +simpl. +Undo. +Abort. + +Goal f (fst (pair nat nat)) = nat. +compute. + match goal with + | [ |- fst ?x = nat ] => fail 1 "compute failed" + | [ |- nat = nat ] => idtac + end. + reflexivity. +Defined. + +Goal fst (pair nat nat) = nat. + unfold fst. + match goal with + | [ |- fst ?x = nat ] => fail 1 "compute failed" + | [ |- nat = nat ] => idtac + end. + reflexivity. +Defined. + +Lemma eta A B : forall x : prod A B, x = pair (fst x) (snd x). reflexivity. Qed. + +Goal forall x : prod nat nat, fst x = 0. + intros. unfold fst. + Fail match goal with + | [ |- fst ?x = 0 ] => idtac + end. +Abort. diff --git a/test-suite/bugs/closed/bug_3664.v b/test-suite/bugs/closed/bug_3664.v new file mode 100644 index 0000000000..cd1427a143 --- /dev/null +++ b/test-suite/bugs/closed/bug_3664.v @@ -0,0 +1,24 @@ +Require Import TestSuite.admit. +Module NonPrim. + Unset Primitive Projections. + Record c := { d : Set }. + Definition a x := d x. + Goal forall x, a x. + intro x. + Fail progress simpl. (* [progress simpl] fails correctly *) + Fail progress cbn. (* [progress cbn] fails correctly *) + admit. + Defined. +End NonPrim. + +Module Prim. + Set Primitive Projections. + Record c := { d : Set }. + Definition a x := d x. + Goal forall x, a x. + intro x. + Fail progress simpl. (* [progress simpl] fails correctly *) + Fail progress cbn. (* [cbn] succeeds incorrectly, giving [d x] *) + admit. + Defined. +End Prim. diff --git a/test-suite/bugs/closed/bug_3665.v b/test-suite/bugs/closed/bug_3665.v new file mode 100644 index 0000000000..f6a13596ca --- /dev/null +++ b/test-suite/bugs/closed/bug_3665.v @@ -0,0 +1,33 @@ +(* File reduced by coq-bug-finder from original input, then from 5449 lines to 44 lines *) +(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 + coqtop version trunk (September 2014) *) +Set Primitive Projections. + +Axiom IsHSet : Type -> Type. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. + +Module withdefault. +Canonical Structure default_HSet := fun T P => (@BuildhSet T P). +Goal forall (z : hSet) (T0 : Type -> Type), + (forall (A : Type) (P : T0 A -> Type) (aa : T0 A), P aa) -> + forall x0 : setT z, Set. + clear; intros z T H. + Set Debug Unification. + Fail refine (H _ _). (* Timeout! *) +Abort. +End withdefault. + +Module withnondefault. +Variable T0 : Type -> Type. +Variable T0hset: forall A, IsHSet (T0 A). + +Canonical Structure nondefault_HSet := fun A =>(@BuildhSet (T0 A) (T0hset A)). +Canonical Structure default_HSet := fun A P =>(@BuildhSet A P). +Goal forall (z : hSet) (T0 : Type -> Type), + (forall (A : Type) (P : T0 A -> Type) (aa : T0 A), P aa) -> + forall x0 : setT z, Set. + clear; intros z T H. + Set Debug Unification. + Fail refine (H _ _). (* Timeout! *) +Abort. +End withnondefault. diff --git a/test-suite/bugs/closed/bug_3666.v b/test-suite/bugs/closed/bug_3666.v new file mode 100644 index 0000000000..c7bc2f22a8 --- /dev/null +++ b/test-suite/bugs/closed/bug_3666.v @@ -0,0 +1,51 @@ +Unset Strict Universe Declaration. +(* File reduced by coq-bug-finder from original input, then from 11542 lines to 325 lines, then from 347 lines to 56 lines, then from 58 lines to 15 lines *) +(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) + +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). +Inductive V : Type@{U'} := | set {A : Type@{U}} (f : A -> V) : V. +Module NonPrim. + Record hProp := hp { hproptype :> Type ; isp : Set}. + Goal forall (A B : Type) (H_f : A -> V -> hProp) (H_g : B -> V -> hProp) + (C : Type) (h : C -> V) (b : B) (a : A) (c : C), + H_f a (h c) -> H_f a (h c) = H_g b (h c) -> H_g b (h c). + intros A B H_f H_g C h b a c H3 H'. + exact (@transport hProp (fun x => x) _ _ H' H3). + Undo. + Set Debug Unification. + exact (H' # H3). + Defined. +End NonPrim. + +Module Prim. + Set Primitive Projections. + Set Universe Polymorphism. + Record hProp := hp { hproptype :> Type ; isp : Set}. + Goal forall (A B : Type) (H_f : A -> V -> hProp) (H_g : B -> V -> hProp) + (C : Type) (h : C -> V) (b : B) (a : A) (c : C), + H_f a (h c) -> H_f a (h c) = H_g b (h c) -> H_g b (h c). + intros A B H_f H_g C h b a c H3 H'. + exact (@transport hProp (fun x => x) _ _ H' H3). + Undo. + Set Debug Unification. + exact (H' # H3). + (* Toplevel input, characters 7-14: +Error: +In environment +A : Type +B : Type +H_f : A -> V -> hProp +H_g : B -> V -> hProp +C : Type +h : C -> V +b : B +a : A +c : C +H3 : H_f a (h c) +H' : H_f a (h c) = H_g b (h c) +Unable to unify "hproptype (H_f a (h c))" with "?T (H_f a (h c))". + *) + Defined. +End Prim. diff --git a/test-suite/bugs/closed/bug_3667.v b/test-suite/bugs/closed/bug_3667.v new file mode 100644 index 0000000000..14a641f018 --- /dev/null +++ b/test-suite/bugs/closed/bug_3667.v @@ -0,0 +1,23 @@ + +Set Primitive Projections. +Axiom ap10 : forall {A B} {f g:A->B} (h:f=g) x, f x = g x. +Axiom IsHSet : Type -> Type. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. +Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d) }. +Set Implicit Arguments. +Record NaturalTransformation C D (F G : Functor C D) := + { components_of :> forall c, morphism D (F c) (G c); + commutes : forall s d (m : morphism C s d), components_of s = components_of s }. +Definition set_cat : PreCategory. + exact ((@Build_PreCategory hSet + (fun x y => x -> y))). +Defined. +Goal forall (A : PreCategory) (F : Functor A set_cat) + (a : A) (x : F a) (nt :NaturalTransformation F F), x = x. + intros. + pose (fun c d m => ap10 (commutes nt c d m)). diff --git a/test-suite/bugs/closed/bug_3668.v b/test-suite/bugs/closed/bug_3668.v new file mode 100644 index 0000000000..3ce37d4f85 --- /dev/null +++ b/test-suite/bugs/closed/bug_3668.v @@ -0,0 +1,54 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 6329 lines to 110 lines, then from 115 lines to 88 lines, then from 93 lines to 72 lines *) +(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) + +Notation "( x ; y )" := (existT _ x y). +Notation "x .1" := (projT1 x) (at level 3, format "x '.1'"). +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. +Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Notation "A <~> B" := (Equiv A B) (at level 85). +Axiom IsHProp : Type -> Type. +Inductive Bool := true | false. +Definition negb (b : Bool) := if b then false else true. +Hypothesis LEM : forall A : Type, IsHProp A -> A + (A -> False). +Axiom cheat : forall {A},A. +Module NonPrim. + Class Contr (A : Type) := { center : A ; contr : (forall y : A, center = y) }. + Definition Book_6_9 : forall X, X -> X. + Proof. + intro X. + pose proof (@LEM (Contr { f : X <~> X & ~(forall x, f x = x) }) cheat) as contrXEquiv. + destruct contrXEquiv as [[f H]|H]; [ exact f.1 | exact (fun x => x) ]. + Defined. + Lemma Book_6_9_not_id b : Book_6_9 Bool b = negb b. + Proof. + unfold Book_6_9. + destruct (@LEM (Contr { f : Bool <~> Bool & ~(forall x, f x = x) }) _) as [[f H']|H']. + match goal with + | [ |- equiv_fun Bool Bool f.1 b = negb b ] => idtac + | [ |- equiv_fun Bool Bool center.1 b = negb b ] => fail 1 "bad" + end. + all:admit. + Defined. +End NonPrim. +Module Prim. + Set Primitive Projections. + Class Contr (A : Type) := { center : A ; contr : (forall y : A, center = y) }. + Definition Book_6_9 : forall X, X -> X. + Proof. + intro X. + pose proof (@LEM (Contr { f : X <~> X & ~(forall x, f x = x) }) cheat) as contrXEquiv. + destruct contrXEquiv as [[f H]|H]; [ exact (f.1) | exact (fun x => x) ]. + Defined. + Lemma Book_6_9_not_id b : Book_6_9 Bool b = negb b. + Proof. + unfold Book_6_9. + destruct (@LEM (Contr { f : Bool <~> Bool & ~(forall x, f x = x) }) _) as [[f H']|H']. + match goal with + | [ |- equiv_fun Bool Bool f.1 b = negb b ] => idtac + | [ |- equiv_fun Bool Bool center.1 b = negb b ] => fail 1 "bad" + end. (* Tactic failure: bad *) + all:admit. + Defined. +End Prim. diff --git a/test-suite/bugs/closed/bug_3670.v b/test-suite/bugs/closed/bug_3670.v new file mode 100644 index 0000000000..a4d5978b48 --- /dev/null +++ b/test-suite/bugs/closed/bug_3670.v @@ -0,0 +1,23 @@ +Set Universe Polymorphism. +Module Type FOO. + Parameter f : Type -> Type. + Parameter h : forall T, f T. +End FOO. + +Module Type BAR. + Include FOO. +End BAR. + +Module Type BAZ. + Include FOO. +End BAZ. + +Module BAR_FROM_BAZ (baz : BAZ) <: BAR. + + Definition f : Type -> Type. + Proof. exact baz.f. Defined. + + Definition h : forall T, f T. + Admitted. + +Fail End BAR_FROM_BAZ. diff --git a/test-suite/bugs/closed/bug_3672.v b/test-suite/bugs/closed/bug_3672.v new file mode 100644 index 0000000000..5573b818b3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3672.v @@ -0,0 +1,27 @@ +Set Primitive Projections. (* No failures without this option. *) + +Record AT := +{ atype :> Type +; coerce : atype -> Type +}. +Coercion coerce : atype >-> Sortclass. + +Record Ar C (A:AT) := { ar : forall (X Y : C), A }. + +Definition t := forall C A a X, coerce _ (ar C A a X X). +Definition t' := forall C A a X, ar C A a X X. + +(* The command has indeed failed with message: +=> Error: The term "ar C A a X X" has type "atype A" which is not a (co-)inductive type. +*) + +Record Ar2 C (A:AT) := +{ ar2 : forall (X Y : C), A +; id2 : forall X, coerce _ (ar2 X X) }. + +Record Ar3 C (A:AT) := +{ ar3 : forall (X Y : C), A +; id3 : forall X, ar3 X X }. +(* The command has indeed failed with message: +=> Anomaly: Bad recursive type. Please report. +*) diff --git a/test-suite/bugs/closed/bug_3675.v b/test-suite/bugs/closed/bug_3675.v new file mode 100644 index 0000000000..93227ab852 --- /dev/null +++ b/test-suite/bugs/closed/bug_3675.v @@ -0,0 +1,20 @@ +Set Primitive Projections. +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. +Notation "p @ q" := (concat p q) (at level 20) : path_scope. +Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : forall x, f (equiv_inv x) = x }. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. +Local Open Scope path_scope. +Local Open Scope equiv_scope. +Generalizable Variables A B C f g. +Lemma isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} +: IsEquiv (compose g f). +Proof. + refine (Build_IsEquiv A C + (compose g f) + (compose f^-1 g^-1) _). + exact (fun c => ap g (@eisretr _ _ f _ (g^-1 c)) @ (@eisretr _ _ g _ c)). diff --git a/test-suite/bugs/closed/bug_3681.v b/test-suite/bugs/closed/bug_3681.v new file mode 100644 index 0000000000..194113c6ed --- /dev/null +++ b/test-suite/bugs/closed/bug_3681.v @@ -0,0 +1,20 @@ +Module Type FOO. + Parameters P Q : Type -> Type. +End FOO. + +Module Type BAR. + Declare Module Import foo : FOO. + Parameter f : forall A, P A -> Q A -> A. +End BAR. + +Module Type BAZ. + Declare Module Export foo : FOO. + Parameter g : forall A, P A -> Q A -> A. +End BAZ. + +Module BAR_FROM_BAZ (baz : BAZ) : BAR. + Import baz. + Module foo <: FOO := foo. + Import foo. + Definition f : forall A, P A -> Q A -> A := g. +End BAR_FROM_BAZ. diff --git a/test-suite/bugs/closed/bug_3682.v b/test-suite/bugs/closed/bug_3682.v new file mode 100644 index 0000000000..9d37d1a2d0 --- /dev/null +++ b/test-suite/bugs/closed/bug_3682.v @@ -0,0 +1,6 @@ +Require Import TestSuite.admit. +Class Foo. +Definition bar `{Foo} (x : Set) := Set. +Instance: Foo. +Definition bar1 := bar nat. +Definition bar2 := bar ltac:(admit). diff --git a/test-suite/bugs/closed/bug_3684.v b/test-suite/bugs/closed/bug_3684.v new file mode 100644 index 0000000000..130d57779d --- /dev/null +++ b/test-suite/bugs/closed/bug_3684.v @@ -0,0 +1,5 @@ +Require Import TestSuite.admit. +Definition foo : Set. +Proof. + refine (ltac:(abstract admit)). +Qed. diff --git a/test-suite/bugs/closed/bug_3685.v b/test-suite/bugs/closed/bug_3685.v new file mode 100644 index 0000000000..7a0c3e6f1d --- /dev/null +++ b/test-suite/bugs/closed/bug_3685.v @@ -0,0 +1,75 @@ +Require Import TestSuite.admit. +Set Universe Polymorphism. +Class Funext := { }. +Delimit Scope category_scope with category. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Set Implicit Arguments. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); + identity_of : forall s m, morphism_of s s m = morphism_of s s m }. +Definition sub_pre_cat `{Funext} (P : PreCategory -> Type) : PreCategory. +Proof. + exact (@Build_PreCategory PreCategory Functor). +Defined. +Definition opposite (C : PreCategory) : PreCategory. +Proof. + exact (@Build_PreCategory C (fun s d => morphism C d s)). +Defined. +Local Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. +Definition prod (C D : PreCategory) : PreCategory. +Proof. + refine (@Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) * morphism D (snd s) (snd d))%type)). +Defined. +Local Infix "*" := prod : category_scope. +Record NaturalTransformation C D (F G : Functor C D) := {}. +Definition functor_category (C D : PreCategory) : PreCategory. +Proof. + exact (@Build_PreCategory (Functor C D) (@NaturalTransformation C D)). +Defined. +Local Notation "C -> D" := (functor_category C D) : category_scope. +Module Export PointwiseCore. + Local Open Scope category_scope. + Definition pointwise + (C C' : PreCategory) + (F : Functor C' C) + (D D' : PreCategory) + (G : Functor D D') + : Functor (C -> D) (C' -> D'). + Proof. + unshelve (refine (Build_Functor + (C -> D) (C' -> D') + _ + _ + _)); + abstract admit. + Defined. +End PointwiseCore. +Axiom Pidentity_of : forall (C D : PreCategory) (F : Functor C C) (G : Functor D D), pointwise F G = pointwise F G. +Local Open Scope category_scope. +Module Success. + Definition functor_uncurried `{Funext} (P : PreCategory -> Type) + (has_functor_categories : forall C D : sub_pre_cat P, P (C -> D)) + : object (((sub_pre_cat P)^op * (sub_pre_cat P)) -> (sub_pre_cat P)) + := Eval cbv zeta in + let object_of := (fun CD => (((fst CD) -> (snd CD)))) + in Build_Functor + ((sub_pre_cat P)^op * (sub_pre_cat P)) (sub_pre_cat P) + object_of + (fun CD C'D' FG => pointwise (fst FG) (snd FG)) + (fun _ _ => @Pidentity_of _ _ _ _). +End Success. +Module Bad. + Include PointwiseCore. + Definition functor_uncurried `{Funext} (P : PreCategory -> Type) + (has_functor_categories : forall C D : sub_pre_cat P, P (C -> D)) + : object (((sub_pre_cat P)^op * (sub_pre_cat P)) -> (sub_pre_cat P)) + := Eval cbv zeta in + let object_of := (fun CD => (((fst CD) -> (snd CD)))) + in Build_Functor + ((sub_pre_cat P)^op * (sub_pre_cat P)) (sub_pre_cat P) + object_of + (fun CD C'D' FG => pointwise (fst FG) (snd FG)) + (fun _ _ => @Pidentity_of _ _ _ _). diff --git a/test-suite/bugs/closed/bug_3686.v b/test-suite/bugs/closed/bug_3686.v new file mode 100644 index 0000000000..df5f667480 --- /dev/null +++ b/test-suite/bugs/closed/bug_3686.v @@ -0,0 +1,63 @@ +Require Import TestSuite.admit. +Set Universe Polymorphism. +Set Implicit Arguments. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Bind Scope category_scope with PreCategory. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); + identity_of : forall s m, morphism_of s s m = morphism_of s s m }. +Definition sub_pre_cat (P : PreCategory -> Type) : PreCategory. +Proof. + exact (@Build_PreCategory PreCategory Functor). +Defined. +Definition opposite (C : PreCategory) : PreCategory. +Proof. + exact (@Build_PreCategory C (fun s d => morphism C d s)). +Defined. +Local Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. +Definition prod (C D : PreCategory) : PreCategory. +Proof. + refine (@Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) * morphism D (snd s) (snd d))%type)). +Defined. +Local Infix "*" := prod : category_scope. +Axiom functor_category : PreCategory -> PreCategory -> PreCategory. +Local Notation "C -> D" := (functor_category C D) : category_scope. +Module Export PointwiseCore. + Definition pointwise + (C C' : PreCategory) + (F : Functor C' C) + (D D' : PreCategory) + (G : Functor D D') + : Functor (C -> D) (C' -> D'). + Proof. + unshelve (refine (Build_Functor + (C -> D) (C' -> D') + _ + _ + _)); + abstract admit. + Defined. +End PointwiseCore. +Axiom Pidentity_of : forall (C D : PreCategory) (F : Functor C C) (G : Functor D D), pointwise F G = pointwise F G. +Local Open Scope category_scope. +Definition functor_uncurried (P : PreCategory -> Type) + (has_functor_categories : forall C D : @sub_pre_cat P, P (C -> D)) +: object (((@sub_pre_cat P)^op * (@sub_pre_cat P)) -> (@sub_pre_cat P)). +Proof. + pose (let object_of := (fun CD => (((fst CD) -> (snd CD)))) + in Build_Functor + ((@sub_pre_cat P)^op * (@sub_pre_cat P)) (@sub_pre_cat P) + object_of + (fun CD C'D' FG => pointwise (fst FG) (snd FG)) + (fun _ _ => Pidentity_of _ _)) || fail "early". + Include PointwiseCore. + pose (let object_of := (fun CD => (((fst CD) -> (snd CD)))) + in Build_Functor + ((@sub_pre_cat P)^op * (@sub_pre_cat P)) (@sub_pre_cat P) + object_of + (fun CD C'D' FG => pointwise (fst FG) (snd FG)) + (fun _ _ => Pidentity_of _ _)). +Abort. diff --git a/test-suite/bugs/closed/bug_3690.v b/test-suite/bugs/closed/bug_3690.v new file mode 100644 index 0000000000..fa30132ab5 --- /dev/null +++ b/test-suite/bugs/closed/bug_3690.v @@ -0,0 +1,48 @@ +Unset Strict Universe Declaration. +Set Printing Universes. +Set Universe Polymorphism. +Definition foo (a := Type) (b := Type) (c := Type) := Type. +Print foo. +(* foo@{Top.2 Top.3 Top.5 Top.6 Top.8 Top.9 Top.10} = +let a := Type@{Top.2} in let b := Type@{Top.5} in let c := Type@{Top.8} in Type@{Top.10} + : Type@{Top.10+1} +(* Top.2 Top.3 Top.5 Top.6 Top.8 Top.9 Top.10 |= Top.2 < Top.3 + Top.5 < Top.6 + Top.8 < Top.9 + *) + *) +Check @foo. (* foo@{Top.11 Top.12 Top.13 Top.14 Top.15 Top.16 +Top.17} + : Type@{Top.17+1} +(* Top.11 Top.12 Top.13 Top.14 Top.15 Top.16 Top.17 |= Top.11 < Top.12 + Top.13 < Top.14 + Top.15 < Top.16 + *) + *) +Definition bar := ltac:(let t := eval compute in foo in exact t). +Check @bar. (* bar@{Top.27} + : Type@{Top.27+1} +(* Top.27 |= *) *) + +Check @bar@{i}. +Definition baz (a := Type) (b := Type : a) (c := Type : b) := a -> c. +Definition qux := Eval compute in baz. +Check @qux. (* qux@{Top.38 Top.39 Top.40 +Top.41} + : Type@{max(Top.38+1, Top.41+1)} +(* Top.38 Top.39 Top.40 Top.41 |= Top.38 < Top.39 + Top.40 < Top.38 + Top.41 < Top.40 + *) *) +Print qux. (* qux@{Top.34 Top.35 Top.36 Top.37} = +Type@{Top.34} -> Type@{Top.37} + : Type@{max(Top.34+1, Top.37+1)} +(* Top.34 Top.35 Top.36 Top.37 |= Top.34 < Top.35 + Top.36 < Top.34 + Top.37 < Top.36 + *) *) +Fail Check @qux@{Set Set}. +Check @qux@{Type Type Type Type}. +(* [qux] should only need two universes *) +Check @qux@{i j k l}. (* Error: The command has not failed!, but I think this is suboptimal *) +Fail Check @qux@{i j}. diff --git a/test-suite/bugs/closed/bug_3692.v b/test-suite/bugs/closed/bug_3692.v new file mode 100644 index 0000000000..72973a8d81 --- /dev/null +++ b/test-suite/bugs/closed/bug_3692.v @@ -0,0 +1,26 @@ +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Reserved Notation "x = y" (at level 70, no associativity). +Reserved Notation "x * y" (at level 40, left associativity). +Delimit Scope core_scope with core. +Open Scope core_scope. +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Global Set Primitive Projections. +Global Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'"). +Generalizable Variables X A B f g n. +Axiom path_prod' : forall {A B : Type} {x x' : A} {y y' : B}, (x = x') -> (y = y') -> ((x,y) = (x',y')). +Definition functor_prod {A A' B B' : Type} (f:A->A') (g:B->B') +: A * B -> A' * B'. + exact (fun z => (f (fst z), g (snd z))). +Defined. +Definition isequiv_functor_prod `{IsEquiv A A' f} `{IsEquiv B B' g} +: IsEquiv (functor_prod f g) + := @Build_IsEquiv + _ _ (functor_prod f g) (functor_prod f^-1 g^-1) + (fun z => path_prod' (@eisretr _ _ f _ (fst z)) (@eisretr _ _ g _ (snd z))). diff --git a/test-suite/bugs/closed/bug_3698.v b/test-suite/bugs/closed/bug_3698.v new file mode 100644 index 0000000000..3882eee97c --- /dev/null +++ b/test-suite/bugs/closed/bug_3698.v @@ -0,0 +1,26 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 5479 lines to 4682 lines, then from 4214 lines to 86 lines, then from 60 lines to 25 lines *) +(* coqc version trunk (October 2014) compiled on Oct 1 2014 18:13:54 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (68846802a7be637ec805a5e374655a426b5723a5) *) +Set Primitive Projections. +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation pr1 := projT1. +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. +Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Global Existing Instance equiv_isequiv. +Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. +Axiom IsHSet : Type -> Type. +Local Open Scope equiv_scope. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. +Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). +Axiom issig_hSet: (sigT IsHSet) <~> hSet. +Definition isequiv_ap_setT X Y : IsEquiv (@ap _ _ setT X Y). +Proof. + assert (H'' : forall g : X = Y -> (issig_hSet^-1 X).1 = (issig_hSet^-1 Y).1, + g = g -> IsEquiv g) by admit. + Eval compute in (@projT1 Type IsHSet (@equiv_inv _ _ _ (equiv_isequiv _ _ issig_hSet) X)). + Fail apply H''. (* stack overflow *) diff --git a/test-suite/bugs/closed/bug_3699.v b/test-suite/bugs/closed/bug_3699.v new file mode 100644 index 0000000000..dbb10f94f2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3699.v @@ -0,0 +1,159 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 9593 lines to 104 lines, then from 187 lines to 103 lines, then from 113 lines to 90 lines *) +(* coqc version trunk (October 2014) compiled on Oct 1 2014 18:13:54 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (68846802a7be637ec805a5e374655a426b5723a5) *) +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Inductive trunc_index := minus_two | trunc_S (_ : trunc_index). +Axiom IsTrunc : trunc_index -> Type -> Type. +Existing Class IsTrunc. +Axiom Contr : Type -> Type. +Inductive Trunc (n : trunc_index) (A :Type) : Type := tr : A -> Trunc n A. +Module NonPrim. + Unset Primitive Projections. + Set Implicit Arguments. + Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. + Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. + Unset Implicit Arguments. + Notation "( x ; y )" := (existT _ x y) : fibration_scope. + Open Scope fibration_scope. + Notation pr1 := projT1. + Notation pr2 := projT2. + Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. + Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. + Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. + Class IsConnected (n : trunc_index) (A : Type) := isconnected_contr_trunc :> Contr (Trunc n A). + Axiom isconnected_elim : forall {n} {A} `{IsConnected n A} + (C : Type) `{IsTrunc n C} (f : A -> C), + { c:C & forall a:A, f a = c }. + Class IsConnMap (n : trunc_index) {A B : Type} (f : A -> B) + := isconnected_hfiber_conn_map :> forall b:B, IsConnected n (hfiber f b). + Definition conn_map_elim {n : trunc_index} + {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} + (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} + (d : forall a:A, P (f a)) + : forall b:B, P b. + Proof. + intros b. + unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). + intro x. + exact (transport P x.2 (d x.1)). + Defined. + + Definition conn_map_elim' {n : trunc_index} + {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} + (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} + (d : forall a:A, P (f a)) + : forall b:B, P b. + Proof. + intros b. + unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). + intros [a p]. + exact (transport P p (d a)). + Defined. + + Definition conn_map_comp {n : trunc_index} + {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} + (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} + (d : forall a:A, P (f a)) + : forall a:A, conn_map_elim f P d (f a) = d a /\ conn_map_elim' f P d (f a) = d a. + Proof. + intros a. + unfold conn_map_elim, conn_map_elim'. + Set Printing Coercions. + set (fibermap := fun a0p : hfiber f (f a) + => let (a0, p) := a0p in transport P p (d a0)). + Set Printing Implicit. + let G := match goal with |- ?G => constr:(G) end in + first [ match goal with + | [ |- (@isconnected_elim n (@hfiber A B f (f a)) + (@isconnected_hfiber_conn_map n A B f H (f a)) + (P (f a)) (HP (f a)) + (fun x : @hfiber A B f (f a) => + @transport B P (f x.1) (f a) x.2 (d x.1))).1 = + d a /\ _ ] => idtac + end + | fail 1 "projection names should be folded, [let] should generate unfolded projections, goal:" G ]; + first [ match goal with + | [ |- _ /\ (@isconnected_elim n (@hfiber A B f (f a)) + (@isconnected_hfiber_conn_map n A B f H (f a)) + (P (f a)) (HP (f a)) fibermap).1 = d a ] => idtac + end + | fail 1 "destruct should generate unfolded projections, as should [let], goal:" G ]. + admit. + Defined. +End NonPrim. + +Module Prim. + Set Primitive Projections. + Set Implicit Arguments. + Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. + Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. + Unset Implicit Arguments. + Notation "( x ; y )" := (existT _ x y) : fibration_scope. + Open Scope fibration_scope. + Notation pr1 := projT1. + Notation pr2 := projT2. + Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. + Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. + Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. + Class IsConnected (n : trunc_index) (A : Type) := isconnected_contr_trunc :> Contr (Trunc n A). + Axiom isconnected_elim : forall {n} {A} `{IsConnected n A} + (C : Type) `{IsTrunc n C} (f : A -> C), + { c:C & forall a:A, f a = c }. + Class IsConnMap (n : trunc_index) {A B : Type} (f : A -> B) + := isconnected_hfiber_conn_map :> forall b:B, IsConnected n (hfiber f b). + Definition conn_map_elim {n : trunc_index} + {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} + (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} + (d : forall a:A, P (f a)) + : forall b:B, P b. + Proof. + intros b. + unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). + intro x. + exact (transport P x.2 (d x.1)). + Defined. + + Definition conn_map_elim' {n : trunc_index} + {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} + (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} + (d : forall a:A, P (f a)) + : forall b:B, P b. + Proof. + intros b. + unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). + intros [a p]. + exact (transport P p (d a)). + Defined. + + Definition conn_map_comp {n : trunc_index} + {A B : Type} (f : A -> B) `{IsConnMap n _ _ f} + (P : B -> Type) {HP : forall b:B, IsTrunc n (P b)} + (d : forall a:A, P (f a)) + : forall a:A, conn_map_elim f P d (f a) = d a /\ conn_map_elim' f P d (f a) = d a. + Proof. + intros a. + unfold conn_map_elim, conn_map_elim'. + Set Printing Coercions. + set (fibermap := fun a0p : hfiber f (f a) + => let (a0, p) := a0p in transport P p (d a0)). + Set Printing Implicit. + let G := match goal with |- ?G => constr:(G) end in + first [ match goal with + | [ |- (@isconnected_elim n (@hfiber A B f (f a)) + (@isconnected_hfiber_conn_map n A B f H (f a)) + (P (f a)) (HP (f a)) + (fun x : @hfiber A B f (f a) => + @transport B P (f x.1) (f a) x.2 (d x.1))).1 = + d a /\ _ ] => idtac + end + | fail 1 "projection names should be folded, [let] should generate unfolded projections, goal:" G ]; + first [ match goal with + | [ |- _ /\ (@isconnected_elim n (@hfiber A B f (f a)) + (@isconnected_hfiber_conn_map n A B f H (f a)) + (P (f a)) (HP (f a)) fibermap).1 = d a ] => idtac + end + | fail 1 "destruct should generate unfolded projections, as should [let], goal:" G ]. + admit. + Defined. +End Prim. diff --git a/test-suite/bugs/closed/bug_3700.v b/test-suite/bugs/closed/bug_3700.v new file mode 100644 index 0000000000..bac443e337 --- /dev/null +++ b/test-suite/bugs/closed/bug_3700.v @@ -0,0 +1,84 @@ + +Set Implicit Arguments. +Module NonPrim. + Unset Primitive Projections. + Record prod A B := pair { fst : A ; snd : B }. +End NonPrim. +Module Prim. + Set Primitive Projections. + Record prod A B := pair { fst : A ; snd : B }. +End Prim. +Goal (forall x : NonPrim.prod Set Set, let (a, b) := x in a = a) +/\ (forall x : Prim.prod Set Set, let (a, b) := x in a = a). + Show. (* (forall x : NonPrim.prod Set Set, let (a, _) := x in a = a) /\ + (forall x : Prim.prod Set Set, + let a := Prim.fst x in let b := Prim.snd x in a = a) *) + Set Printing All. + Show. (* and + (forall x : NonPrim.prod Set Set, + match x return Prop with + | NonPrim.pair a _ => @eq Set a a + end) + (forall x : Prim.prod Set Set, + let a := @Prim.fst Set Set x in + let b := @Prim.snd Set Set x in @eq Set a a) *) + Unset Printing All. +Abort. +Goal (forall x : NonPrim.prod Set Set, match x with NonPrim.pair a b => a = a end) +/\ (forall x : Prim.prod Set Set, match x with Prim.pair a b => a = a end). + Show. (* (forall x : NonPrim.prod Set Set, + match x with + | {| NonPrim.fst := a |} => a = a + end) /\ (forall x : Prim.prod Set Set, Prim.fst x = Prim.fst x) *) + (** Wrong: [match] should generate unfolded things *) + Set Printing All. + Show. (* and + (forall x : NonPrim.prod Set Set, + match x return Prop with + | NonPrim.pair a _ => @eq Set a a + end) + (forall x : Prim.prod Set Set, + @eq Set (@Prim.fst Set Set x) (@Prim.fst Set Set x)) *) + Unset Printing All. +Abort. +Goal (forall x : NonPrim.prod Set Set, let (a, b) := x in a = a /\ b = b) +/\ (forall x : Prim.prod Set Set, let (a, b) := x in a = a /\ b = b). + Show. (* (forall x : NonPrim.prod Set Set, let (a, b) := x in a = a /\ b = b) /\ + (forall x : Prim.prod Set Set, + let a := Prim.fst x in let b := Prim.snd x in a = a /\ b = b) *) + (** Understandably different, maybe, but should still be unfolded *) + Set Printing All. + Show. (* and + (forall x : NonPrim.prod Set Set, + match x return Prop with + | NonPrim.pair a b => and (@eq Set a a) (@eq Set b b) + end) + (forall x : Prim.prod Set Set, + let a := @Prim.fst Set Set x in + let b := @Prim.snd Set Set x in and (@eq Set a a) (@eq Set b b)) *) + Unset Printing All. +Abort. +Goal (forall x : NonPrim.prod Set Set, match x with NonPrim.pair a b => a = a /\ b = b end) +/\ (forall x : Prim.prod Set Set, match x with Prim.pair a b => a = a /\ b = b end). + Show. (* (forall x : NonPrim.prod Set Set, + match x with + | {| NonPrim.fst := a; NonPrim.snd := b |} => a = a /\ b = b + end) /\ + (forall x : Prim.prod Set Set, + Prim.fst x = Prim.fst x /\ Prim.snd x = Prim.snd x) *) + Set Printing All. + Show. + + set(foo:=forall x : Prim.prod Set Set, match x return Set with + | Prim.pair fst _ => fst + end). + (* and + (forall x : NonPrim.prod Set Set, + match x return Prop with + | NonPrim.pair a b => and (@eq Set a a) (@eq Set b b) + end) + (forall x : Prim.prod Set Set, + and (@eq Set (@Prim.fst Set Set x) (@Prim.fst Set Set x)) + (@eq Set (@Prim.snd Set Set x) (@Prim.snd Set Set x))) *) + Unset Printing All. +Abort. diff --git a/test-suite/bugs/closed/bug_3703.v b/test-suite/bugs/closed/bug_3703.v new file mode 100644 index 0000000000..feeb04d64e --- /dev/null +++ b/test-suite/bugs/closed/bug_3703.v @@ -0,0 +1,32 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 6746 lines to 4190 lines, then from 29 lines to 18 lines, then fro\ +m 30 lines to 19 lines *) +(* coqc version trunk (October 2014) compiled on Oct 7 2014 12:42:41 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (2313bde0116a5916912bebbaca77d291f7b2760a) *) +Record PreCategory := { identity : forall x, x -> x }. +Definition set_cat : PreCategory := @Build_PreCategory (fun T x => x). +Module UnKeyed. + Global Unset Keyed Unification. + Goal forall (T : Type) (g0 g1 : T) (k : T) (H' : forall x : T, k = @identity set_cat T x), + ((fun x : T => x) g0) = ((fun x : T => x) g1). + intros T g0 g1 k H'. + change (identity _ _) with (fun y : T => y) in H'; + rewrite <- H' || fail "too early". + Undo. + rewrite <- H'. + admit. + Defined. +End UnKeyed. +Module Keyed. + Global Set Keyed Unification. + Declare Equivalent Keys (fun x => _) identity. + Goal forall (T : Type) (g0 g1 : T) (k : T) (H' : forall x : T, k = @identity set_cat T x), + ((fun x : T => x) g0) = ((fun x : T => x) g1). + intros T g0 g1 k H'. + change (identity _ _) with (fun y : T => y) in H'; + rewrite <- H' || fail "too early". + Undo. + rewrite <- H'. + admit. + Defined. +End Keyed. diff --git a/test-suite/bugs/closed/bug_3709.v b/test-suite/bugs/closed/bug_3709.v new file mode 100644 index 0000000000..815f5b9507 --- /dev/null +++ b/test-suite/bugs/closed/bug_3709.v @@ -0,0 +1,24 @@ +Require Import TestSuite.admit. +Module NonPrim. + Unset Primitive Projections. + Record hProp := hp { hproptype :> Type }. + Goal forall (h : (Type -> hProp) -> (Type -> hProp)) k f, + (forall y, h y = y) -> + h (fun b : Type => {| hproptype := f b |}) = k. + Proof. + intros h k f H. + etransitivity. + apply H. + admit. + Defined. +End NonPrim. +Module Prim. + Set Primitive Projections. + Record hProp := hp { hproptype :> Type }. + Goal forall (h : (Type -> hProp) -> (Type -> hProp)) k f, + (forall y, h y = y) -> + h (fun b : Type => {| hproptype := f b |}) = k. + Proof. + intros h k f H. + etransitivity. + apply H. diff --git a/test-suite/bugs/closed/bug_3710.v b/test-suite/bugs/closed/bug_3710.v new file mode 100644 index 0000000000..b9e2798d88 --- /dev/null +++ b/test-suite/bugs/closed/bug_3710.v @@ -0,0 +1,48 @@ +(* File reduced by coq-bug-finder from original input, then from 13477 lines to 1457 lines, then from 1553 lines to 1586 lines, then \ +from 1574 lines to 823 lines, then from 837 lines to 802 lines, then from 793 lines to 657 lines, then from 661 lines to 233 lines, t\ +hen from 142 lines to 65 lines *) +(* coqc version trunk (October 2014) compiled on Oct 8 2014 13:38:17 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (335cf2860bfd9e714d14228d75a52fd2c88db386) *) +Set Universe Polymorphism. +Set Primitive Projections. +Set Implicit Arguments. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. +Definition relation (A : Type) := A -> A -> Type. +Class Reflexive {A} (R : relation A) := reflexivity : forall x : A, R x x. +Notation "( x ; y )" := (existT _ x y). +Notation "x .1" := (projT1 x) (at level 3, format "x '.1'"). +Reserved Infix "o" (at level 40, left associativity). +Delimit Scope category_scope with category. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + compose : forall s d d', morphism d d' -> morphism s d -> morphism s d' }. +Delimit Scope functor_scope with functor. +Record Functor (C D : PreCategory) := { object_of :> C -> D }. +Local Open Scope category_scope. +Class Isomorphic {C : PreCategory} (s d : C) := {}. +Axiom composeF : forall C D E (G : Functor D E) (F : Functor C D), Functor C E. +Infix "o" := composeF : functor_scope. +Local Open Scope functor_scope. +Definition sub_pre_cat {P : PreCategory -> Type} : PreCategory. + exact (@Build_PreCategory + { C : PreCategory & P C } + (fun C D => Functor C.1 D.1) + (fun _ _ _ F G => F o G)). +Defined. +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. +Axiom composeT : forall C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F'), + NaturalTransformation F F''. +Definition functor_category (C D : PreCategory) : PreCategory. + exact (@Build_PreCategory (Functor C D) + (@NaturalTransformation C D) + (@composeT C D)). +Defined. +Local Notation "C -> D" := (functor_category C D) : category_scope. +Definition NaturalIsomorphism (C D : PreCategory) F G : Type := @Isomorphic (C -> D) F G. +Context `{P : PreCategory -> Type}. +Local Notation cat := (@sub_pre_cat P). +Goal forall (s d d' : cat) (m1 : morphism cat d d') (m2 : morphism cat s d), + NaturalIsomorphism (m1 o m2) (m1 o m2)%functor. +Fail exact (fun _ _ _ _ _ => reflexivity _). diff --git a/test-suite/bugs/closed/bug_3723.v b/test-suite/bugs/closed/bug_3723.v new file mode 100644 index 0000000000..d0b77c451b --- /dev/null +++ b/test-suite/bugs/closed/bug_3723.v @@ -0,0 +1,6 @@ +(* Bugs #3787 and #3723 on reinitializing camlp5 levels *) + +Definition a := True. +Reserved Notation "-- x" (at level 50, x at level 20). +Reserved Notation "--- x" (at level 20). +Reset a. diff --git a/test-suite/bugs/closed/bug_3732.v b/test-suite/bugs/closed/bug_3732.v new file mode 100644 index 0000000000..e6715ee44e --- /dev/null +++ b/test-suite/bugs/closed/bug_3732.v @@ -0,0 +1,105 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 2073 lines to 358 lines, then from 359 lines to 218 lines, then from 107 lines to 92 lines *) +(* coqc version trunk (October 2014) compiled on Oct 11 2014 1:13:41 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d65496f09c4b68fa318783e53f9cd6d5c18e1eb7) *) +Require Coq.Lists.List. + +Import Coq.Lists.List. + +Set Implicit Arguments. +Global Set Asymmetric Patterns. + +Section machine. + Variables pc state : Type. + + Inductive propX (i := pc) (j := state) : list Type -> Type := + | Inj : forall G, Prop -> propX G + | ExistsX : forall G A, propX (A :: G) -> propX G. + + Arguments Inj [G]. + + Definition PropX := propX nil. + Fixpoint last (G : list Type) : Type. + exact (match G with + | nil => unit + | T :: nil => T + | _ :: G' => last G' + end). + Defined. + Fixpoint eatLast (G : list Type) : list Type. + exact (match G with + | nil => nil + | _ :: nil => nil + | x :: G' => x :: eatLast G' + end). + Defined. + + Fixpoint subst G (p : propX G) : (last G -> PropX) -> propX (eatLast G) := + match p with + | Inj _ P => fun _ => Inj P + | ExistsX G A p1 => fun p' => + match G return propX (A :: G) -> propX (eatLast (A :: G)) -> propX (eatLast G) with + | nil => fun p1 _ => ExistsX p1 + | _ :: _ => fun _ rc => ExistsX rc + end p1 (subst p1 (match G return (last G -> PropX) -> last (A :: G) -> PropX with + | nil => fun _ _ => Inj True + | _ => fun p' => p' + end p')) + end. + + Definition spec := state -> PropX. + Definition codeSpec := pc -> option spec. + + Inductive valid (specs : codeSpec) (G : list PropX) : PropX -> Prop := Env : forall P, In P G -> valid specs G P. + Definition interp specs := valid specs nil. +End machine. +Notation "'ExX' : A , P" := (ExistsX (A := A) P) (at level 89) : PropX_scope. +Bind Scope PropX_scope with PropX propX. +Variables pc state : Type. + +Inductive subs : list Type -> Type := +| SNil : subs nil +| SCons : forall T Ts, (last (T :: Ts) -> PropX pc state) -> subs (eatLast (T :: Ts)) -> subs (T :: Ts). + +Fixpoint SPush G T (s : subs G) (f : T -> PropX pc state) : subs (T :: G) := + match s in subs G return subs (T :: G) with + | SNil => SCons _ nil f SNil + | SCons T' Ts f' s' => SCons T (T' :: Ts) f' (SPush s' f) + end. + +Fixpoint Substs G (s : subs G) : propX pc state G -> PropX pc state := + match s in subs G return propX pc state G -> PropX pc state with + | SNil => fun p => p + | SCons _ _ f s' => fun p => Substs s' (subst p f) + end. +Variable specs : codeSpec pc state. + +Lemma simplify_fwd_ExistsX : forall G A s (p : propX pc state (A :: G)), + interp specs (Substs s (ExX : A, p)) + -> exists a, interp specs (Substs (SPush s a) p). +admit. +Defined. + +Goal forall (G : list Type) (A : Type) (p : propX pc state (@cons Type A G)) + (s : subs G) + (_ : @interp pc state specs (@Substs G s (@ExistsX pc state G A p))) + (P : forall _ : subs (@cons Type A G), Prop) + (_ : forall (s0 : subs (@cons Type A G)) + (_ : @interp pc state specs (@Substs (@cons Type A G) s0 p)), + P s0), + @ex (forall _ : A, PropX pc state) + (fun a : forall _ : A, PropX pc state => P (@SPush G A s a)). + intros ? ? ? ? H ? H'. + apply simplify_fwd_ExistsX in H. + firstorder. +Qed. + (* Toplevel input, characters 15-19: +Error: Illegal application: +The term "cons" of type "forall A : Type, A -> list A -> list A" +cannot be applied to the terms + "Type" : "Type" + "T" : "Type" + "G0" : "list Type" +The 2nd term has type "Type@{Top.53}" which should be coercible to + "Type@{Top.12}". + *) diff --git a/test-suite/bugs/closed/bug_3735.v b/test-suite/bugs/closed/bug_3735.v new file mode 100644 index 0000000000..00886cbc60 --- /dev/null +++ b/test-suite/bugs/closed/bug_3735.v @@ -0,0 +1,4 @@ +Require Import Coq.Program.Tactics. +Class Foo := { bar : Type }. +Fail Lemma foo : Foo -> bar. (* 'Command has indeed failed.' in both 8.4 and trunk *) +Fail Program Lemma foo : Foo -> bar. diff --git a/test-suite/bugs/closed/bug_3736.v b/test-suite/bugs/closed/bug_3736.v new file mode 100644 index 0000000000..637b77cc58 --- /dev/null +++ b/test-suite/bugs/closed/bug_3736.v @@ -0,0 +1,8 @@ +(* Check non-error failure in case of unsupported decidability scheme *) +Local Set Decidable Equality Schemes. + +Inductive a := A with b := B. + +(* But fails with error if explicitly asked for the scheme *) + +Fail Scheme Equality for a. diff --git a/test-suite/bugs/closed/bug_3743.v b/test-suite/bugs/closed/bug_3743.v new file mode 100644 index 0000000000..ca78987bf3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3743.v @@ -0,0 +1,11 @@ +(* File reduced by coq-bug-finder from original input, then from 967 lines to 469 lines, then from 459 lines to 35 lines *) +(* coqc version trunk (October 2014) compiled on Oct 11 2014 1:13:41 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d65496f09c4b68fa318783e53f9cd6d5c18e1eb7) *) +Require Export Coq.Setoids.Setoid. + +Add Parametric Relation A +: A (@eq A) + transitivity proved by transitivity + as refine_rel. +(* Toplevel input, characters 20-118: +Anomaly: index to an anonymous variable. Please report. *) diff --git a/test-suite/bugs/closed/bug_3746.v b/test-suite/bugs/closed/bug_3746.v new file mode 100644 index 0000000000..a9463f94bb --- /dev/null +++ b/test-suite/bugs/closed/bug_3746.v @@ -0,0 +1,92 @@ + +(* Bug report #3746 : Include and restricted signature *) + +Module Type MT. Parameter p : nat. End MT. +Module Type EMPTY. End EMPTY. +Module Empty. End Empty. + +(* Include of an applied functor with restricted sig : + Used to create axioms (bug report #3746), now forbidden. *) + +Module F (X:EMPTY) : MT. + Definition p := 0. +End F. + +Module InclFunctRestr. + Fail Include F(Empty). +End InclFunctRestr. + +(* A few variants (indirect restricted signature), also forbidden. *) + +Module F1 := F. +Module F2 (X:EMPTY) := F X. + +Module F3a (X:EMPTY). Definition p := 0. End F3a. +Module F3 (X:EMPTY) : MT := F3a X. + +Module InclFunctRestrBis. + Fail Include F1(Empty). + Fail Include F2(Empty). + Fail Include F3(Empty). +End InclFunctRestrBis. + +(* Recommended workaround: manual instance before the include. *) + +Module InclWorkaround. + Module Temp := F(Empty). + Include Temp. +End InclWorkaround. + +Compute InclWorkaround.p. +Print InclWorkaround.p. +Print Assumptions InclWorkaround.p. (* Closed under the global context *) + + + +(* Related situations which are ok, just to check *) + +(* A) Include of non-functor with restricted signature : + creates a proxy to initial stuff *) + +Module M : MT. + Definition p := 0. +End M. + +Module InclNonFunct. + Include M. +End InclNonFunct. + +Definition check : InclNonFunct.p = M.p := eq_refl. +Print Assumptions InclNonFunct.p. (* Closed *) + + +(* B) Include of a module type with opaque content: + The opaque content is "copy-pasted". *) + +Module Type SigOpaque. + Definition p : nat. Proof. exact 0. Qed. +End SigOpaque. + +Module InclSigOpaque. + Include SigOpaque. +End InclSigOpaque. + +Compute InclSigOpaque.p. +Print InclSigOpaque.p. +Print Assumptions InclSigOpaque.p. (* Closed *) + + +(* C) Include of an applied functor with opaque proofs : + opaque proof "copy-pasted" (and substituted). *) + +Module F' (X:EMPTY). + Definition p : nat. Proof. exact 0. Qed. +End F'. + +Module InclFunctOpa. + Include F'(Empty). +End InclFunctOpa. + +Compute InclFunctOpa.p. +Print InclFunctOpa.p. +Print Assumptions InclFunctOpa.p. (* Closed *) diff --git a/test-suite/bugs/closed/bug_3753.v b/test-suite/bugs/closed/bug_3753.v new file mode 100644 index 0000000000..f586438cdd --- /dev/null +++ b/test-suite/bugs/closed/bug_3753.v @@ -0,0 +1,4 @@ +Axiom foo : Type -> Type. +Axiom bar : forall (T : Type), T -> foo T. +Arguments bar A x : rename. +About bar. diff --git a/test-suite/bugs/closed/bug_3755.v b/test-suite/bugs/closed/bug_3755.v new file mode 100644 index 0000000000..f0b542d31e --- /dev/null +++ b/test-suite/bugs/closed/bug_3755.v @@ -0,0 +1,16 @@ +(* File reduced by coq-bug-finder from original input, then from 6729 lines to +411 lines, then from 148 lines to 115 lines, then from 99 lines to 70 lines, +then from 85 lines to 63 lines, then from 76 lines to 55 lines, then from 61 +lines to 17 lines *) +(* coqc version trunk (January 2015) compiled on Jan 17 2015 21:58:5 with OCaml +4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk +(9e6b28c04ad98369a012faf3bd4d630cf123a473) *) +Set Printing Universes. +Section param. + Variable typeD : Set -> Set. + Variable STex : forall (T : Type) (p : T -> Set), Set. + Definition existsEach_cons' v (P : @sigT _ typeD -> Set) := + @STex _ (fun x => P (@existT _ _ v x)). + + Check @existT _ _ STex STex. diff --git a/test-suite/bugs/closed/bug_3777.v b/test-suite/bugs/closed/bug_3777.v new file mode 100644 index 0000000000..e203528fcc --- /dev/null +++ b/test-suite/bugs/closed/bug_3777.v @@ -0,0 +1,17 @@ +Unset Strict Universe Declaration. +Module WithoutPoly. + Unset Universe Polymorphism. + Definition foo (A : Type@{i}) (B : Type@{i}) := A -> B. + Set Printing Universes. + Definition bla := ((@foo : Set -> _ -> _) : _ -> Type -> _). + (* ((fun A : Set => foo A):Set -> Type@{Top.55} -> Type@{Top.55}) +:Set -> Type@{Top.55} -> Type@{Top.55} + : Set -> Type@{Top.55} -> Type@{Top.55} +(* |= Set <= Top.55 + *) *) +End WithoutPoly. +Module WithPoly. + Set Universe Polymorphism. + Definition foo (A : Type@{i}) (B : Type@{i}) := A -> B. + Set Printing Universes. + Fail Check ((@foo : Set -> _ -> _) : _ -> Type -> _). diff --git a/test-suite/bugs/closed/bug_3779.v b/test-suite/bugs/closed/bug_3779.v new file mode 100644 index 0000000000..2b44e225e8 --- /dev/null +++ b/test-suite/bugs/closed/bug_3779.v @@ -0,0 +1,12 @@ +Unset Strict Universe Declaration. +Set Universe Polymorphism. +Record UnitSubuniverse := { a : Type@{sm} ; x : (Type@{sm} : Type@{lg}) ; inO_internal : Type@{lg} -> Type@{lg} }. +Class In (O : UnitSubuniverse@{sm lg}) (T : Type@{lg}) := in_inO_internal : inO_internal O T. +Section foo. + Universes sm lg. + Context (O : UnitSubuniverse@{sm lg}). + Context {A : Type@{sm}}. + Context (H' : forall (C : Type@{lg}) `{In@{sm lg} O C} (f : A -> C), In@{sm lg} O C). + Fail Check (H' : forall (C : Type@{lg}) `{In@{i j} O C} (f : A -> C), In@{j i} O C). + Fail Context (H'' : forall (C : Type@{lg}) `{In@{i j} O C} (f : A -> C), In@{j i} O C). +End foo. diff --git a/test-suite/bugs/closed/bug_3782.v b/test-suite/bugs/closed/bug_3782.v new file mode 100644 index 0000000000..16b0b8b603 --- /dev/null +++ b/test-suite/bugs/closed/bug_3782.v @@ -0,0 +1,64 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 2674 lines to 136 lines, then from 115 lines to 61 lines *) +(* coqc version trunk (October 2014) compiled on Oct 28 2014 14:33:38 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,(no branch) (53bfe9cf58a3c40e6eb7120d25c1633a9cea3126) *) +Class IsEquiv {A B : Type} (f : A -> B) := {}. +Record Equiv A B := { equiv_fun : A -> B ; equiv_isequiv : IsEquiv equiv_fun }. +Arguments equiv_fun {A B} _ _. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Set Printing Coercions. +Set Printing Implicit. +Module NonPrim. + Unset Primitive Projections. + Record TruncType (n : nat) := { trunctype_type :> Type }. + Canonical Structure default_TruncType := fun n T => (@Build_TruncType n T). + Goal (forall (s d : TruncType 0) (m : trunctype_type 0 s -> trunctype_type 0 d), + @IsEquiv (trunctype_type 0 s) (trunctype_type 0 d) m -> Type) -> + forall (T T0 : Type) (m : T0 -> T), @IsEquiv T0 T m -> True. + intros isiso_isequiv' mc md e e'. + (pose (@isiso_isequiv' + _ _ + (e + : (Build_TruncType 0 md) -> + (Build_TruncType 0 mc)) + e') as i || fail "too early"); clear i. + pose (@isiso_isequiv' + _ _ _ + e'). + admit. + Defined. +End NonPrim. +Module Prim. + Set Primitive Projections. + Record TruncType (n : nat) := { trunctype_type :> Type }. + Canonical Structure default_TruncType := fun n T => (@Build_TruncType n T). + Goal (forall (s d : TruncType 0) (m : trunctype_type 0 s -> trunctype_type 0 d), + @IsEquiv (trunctype_type 0 s) (trunctype_type 0 d) m -> Type) -> + forall (T T0 : Type) (m : T0 -> T), @IsEquiv T0 T m -> True. + intros isiso_isequiv' mc md e e'. + (pose (@isiso_isequiv' + _ _ + (e + : (Build_TruncType 0 md) -> + (Build_TruncType 0 mc)) + e') as i || fail "too early"); clear i. + Set Printing Existential Instances. + Set Debug Unification. + pose (@isiso_isequiv' + _ _ _ + e'). (* Toplevel input, characters 48-50: +Error: +In environment +isiso_isequiv' : forall (s d : TruncType 0) + (m : trunctype_type 0 s -> trunctype_type 0 d), + @IsEquiv (trunctype_type 0 s) (trunctype_type 0 d) m -> Type +mc : Type +md : Type +e : md -> mc +e' : @IsEquiv md mc e +The term "e'" has type "@IsEquiv md mc e" while it is expected to have type + "@IsEquiv (trunctype_type 0 ?t) (trunctype_type 0 ?t0) ?t1". + *) + admit. + Defined. +End Prim. diff --git a/test-suite/bugs/closed/bug_3783.v b/test-suite/bugs/closed/bug_3783.v new file mode 100644 index 0000000000..f7e2b54353 --- /dev/null +++ b/test-suite/bugs/closed/bug_3783.v @@ -0,0 +1,33 @@ +Require Import TestSuite.admit. +Fixpoint exp (n : nat) (T : Set) + := match n with + | 0 => T + | S n' => exp n' (T * T) + end. +Definition big := Eval compute in exp 13 nat. +Module NonPrim. + Unset Primitive Projections. + Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. + Definition x : sigT (fun x => x). + Proof. + exists big; admit. + Defined. + Goal True. + pose ((fun y => y = y) (projT1 _ x)) as y. + Time cbv beta in y. (* 0s *) + admit. + Defined. +End NonPrim. +Module Prim. + Set Primitive Projections. + Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. + Definition x : sigT (fun x => x). + Proof. + exists big; admit. + Defined. + Goal True. + pose ((fun y => y = y) (projT1 _ x)) as y. + Timeout 1 cbv beta in y. (* takes around 2s. Grows with the value passed to [exp] above *) + admit. + Defined. +End Prim. diff --git a/test-suite/bugs/closed/bug_3786.v b/test-suite/bugs/closed/bug_3786.v new file mode 100644 index 0000000000..23d19e946f --- /dev/null +++ b/test-suite/bugs/closed/bug_3786.v @@ -0,0 +1,33 @@ +Require Import TestSuite.admit. +Require Coq.Lists.List. +Require Coq.Sets.Ensembles. +Import Coq.Sets.Ensembles. +Global Set Implicit Arguments. +Delimit Scope comp_scope with comp. +Inductive Comp : Type -> Type := +| Return : forall A, A -> Comp A +| Bind : forall A B, Comp A -> (A -> Comp B) -> Comp B +| Pick : forall A, Ensemble A -> Comp A. +Notation ret := Return. +Notation "x <- y ; z" := (Bind y%comp (fun x => z%comp)) + (at level 81, right associativity, + format "'[v' x <- y ; '/' z ']'") : comp_scope. +Axiom refine : forall {A} (old : Comp A) (new : Comp A), Prop. +Open Scope comp. +Axiom elements : forall {A} (ls : list A), Ensemble A. +Axiom to_list : forall {A} (S : Ensemble A), Comp (list A). +Axiom finite_set_handle_cardinal : refine (ret 0) (ret 0). +Definition sumUniqueSpec (ls : list nat) : Comp nat. + exact (ls' <- to_list (elements ls); + List.fold_right (fun a b' => Bind b' ((fun a b => ret (a + b)) a)) (ret 0) ls'). +Defined. +Axiom admit : forall {T}, T. +Definition sumUniqueImpl (ls : list nat) +: { c : _ | refine (sumUniqueSpec ls) (ret c) }%type. +Proof. + eexists. + match goal with + | [ |- refine ?a ?b ] => let a' := eval hnf in a in change (refine a' b) + end. + try setoid_rewrite (@finite_set_handle_cardinal). +Abort. diff --git a/test-suite/bugs/closed/bug_3788.v b/test-suite/bugs/closed/bug_3788.v new file mode 100644 index 0000000000..2c5b9cb018 --- /dev/null +++ b/test-suite/bugs/closed/bug_3788.v @@ -0,0 +1,6 @@ +Set Implicit Arguments. +Global Set Primitive Projections. +Record Functor (C D : Type) := { object_of :> forall _ : C, D }. +Axiom path_functor_uncurried : forall C D (F G : Functor C D) (_ : sigT (fun HO : object_of F = object_of G => Set)), F = G. +Fail Lemma path_functor_uncurried_snd C D F G HO HM +: (@path_functor_uncurried C D F G (existT _ HO HM)) = HM. diff --git a/test-suite/bugs/closed/bug_3792.v b/test-suite/bugs/closed/bug_3792.v new file mode 100644 index 0000000000..39057b9c52 --- /dev/null +++ b/test-suite/bugs/closed/bug_3792.v @@ -0,0 +1,4 @@ +Fail Definition pull_if_dep +: forall {A} (P : bool -> Type) (a : A true) (a' : A false) + (b : bool), + P (if b as b return A b then a else a'). diff --git a/test-suite/bugs/closed/bug_3798.v b/test-suite/bugs/closed/bug_3798.v new file mode 100644 index 0000000000..b9f0daa71c --- /dev/null +++ b/test-suite/bugs/closed/bug_3798.v @@ -0,0 +1,12 @@ +Require Import TestSuite.admit. +Require Setoid. + +Parameter f : nat -> nat. +Axiom a : forall n, 0 < n -> f n = 0. +Hint Rewrite a using ( simpl; admit ). + +Goal f 1 = 0. +Proof. + rewrite_strat (topdown (hints core)). + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_3804.v b/test-suite/bugs/closed/bug_3804.v new file mode 100644 index 0000000000..da9290cbad --- /dev/null +++ b/test-suite/bugs/closed/bug_3804.v @@ -0,0 +1,12 @@ +Set Universe Polymorphism. +Module Foo. + Definition T : sigT (fun x => x). + Proof. + exists Set. + abstract exact nat. + Defined. +End Foo. +Module Bar. + Include Foo. +End Bar. +Definition foo := eq_refl : Foo.T = Bar.T. diff --git a/test-suite/bugs/closed/bug_3807.v b/test-suite/bugs/closed/bug_3807.v new file mode 100644 index 0000000000..a6286f0377 --- /dev/null +++ b/test-suite/bugs/closed/bug_3807.v @@ -0,0 +1,33 @@ +Set Universe Polymorphism. +Set Printing Universes. +Unset Universe Minimization ToSet. + + +Definition foo : Type := nat. +About foo. +(* foo@{Top.1} : Type@{Top.1}*) +(* Top.1 |= *) + +Definition bar : foo -> nat. +Admitted. +About bar. +(* bar@{Top.2} : foo@{Top.2} -> nat *) +(* Top.2 |= *) + +Lemma baz@{i} : foo@{i} -> nat. +Proof. + exact bar. +Defined. + +Definition bar'@{i} : foo@{i} -> nat. + intros f. exact 0. +Admitted. +About bar'. +(* bar'@{i} : foo@{i} -> nat *) +(* i |= *) + +Axiom f@{i} : Type@{i}. +(* +*** [ f@{i} : Type@{i} ] +(* i |= *) +*) diff --git a/test-suite/bugs/closed/bug_3808.v b/test-suite/bugs/closed/bug_3808.v new file mode 100644 index 0000000000..ac6a850193 --- /dev/null +++ b/test-suite/bugs/closed/bug_3808.v @@ -0,0 +1,3 @@ +Unset Strict Universe Declaration. +Inductive Foo : (let enforce := (fun x => x) : Type@{j} -> Type@{i} in Type@{i}) + := foo : Foo. diff --git a/test-suite/bugs/closed/bug_3815.v b/test-suite/bugs/closed/bug_3815.v new file mode 100644 index 0000000000..5fb4839847 --- /dev/null +++ b/test-suite/bugs/closed/bug_3815.v @@ -0,0 +1,9 @@ +Require Import Setoid Coq.Program.Basics. +Global Open Scope program_scope. +Axiom foo : forall A (f : A -> A), f ∘ f = f. +Require Import Coq.Program.Combinators. +Hint Rewrite foo. +Theorem t {A B C D} (f : A -> A) (g : B -> C) (h : C -> D) +: f ∘ f = f. +Proof. + rewrite_strat topdown (hints core). diff --git a/test-suite/bugs/closed/bug_3819.v b/test-suite/bugs/closed/bug_3819.v new file mode 100644 index 0000000000..0b9c3183cc --- /dev/null +++ b/test-suite/bugs/closed/bug_3819.v @@ -0,0 +1,9 @@ +Record Op := { t : Type ; op : t -> t }. + +Canonical Structure OpType : Op := Build_Op Type (fun X => X). + +Lemma test1 (X:Type) : eq (op OpType X) X. +Proof eq_refl. + +Definition test2 (A:Type) : eq (op _ A) A. +Proof eq_refl. diff --git a/test-suite/bugs/closed/bug_3821.v b/test-suite/bugs/closed/bug_3821.v new file mode 100644 index 0000000000..f6056c51d3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3821.v @@ -0,0 +1,2 @@ +Unset Strict Universe Declaration. +Inductive quotient {A : Type@{i}} {B : Type@{j}} : Type@{max(i, j)} := . diff --git a/test-suite/bugs/closed/bug_3825.v b/test-suite/bugs/closed/bug_3825.v new file mode 100644 index 0000000000..b141965f0f --- /dev/null +++ b/test-suite/bugs/closed/bug_3825.v @@ -0,0 +1,23 @@ +Set Universe Polymorphism. +Set Printing Universes. + +Axiom foo@{i j} : Type@{i} -> Type@{j}. + +Notation bar := foo. + +Monomorphic Universes i j. + +Check bar@{i j}. +Fail Check bar@{i}. + +Notation qux := (nat -> nat). + +Fail Check qux@{i}. + +Axiom TruncType@{i} : nat -> Type@{i}. + +Notation "n -Type" := (TruncType n) (at level 1) : type_scope. +Notation hProp := (0)-Type. + +Check hProp. +Check hProp@{i}. diff --git a/test-suite/bugs/closed/bug_3828.v b/test-suite/bugs/closed/bug_3828.v new file mode 100644 index 0000000000..ae11c6c96c --- /dev/null +++ b/test-suite/bugs/closed/bug_3828.v @@ -0,0 +1,2 @@ +Goal 0 = 0. +Fail pose ?Goal. diff --git a/test-suite/bugs/closed/bug_3848.v b/test-suite/bugs/closed/bug_3848.v new file mode 100644 index 0000000000..c0ef02f1e8 --- /dev/null +++ b/test-suite/bugs/closed/bug_3848.v @@ -0,0 +1,22 @@ +Require Import TestSuite.admit. +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B} (f : A -> B) := { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. +Arguments eisretr {A B} f {_} _. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'"). +Generalizable Variables A B f g e n. +Definition functor_forall `{P : A -> Type} `{Q : B -> Type} + (f0 : B -> A) (f1 : forall b:B, P (f0 b) -> Q b) +: (forall a:A, P a) -> (forall b:B, Q b). + admit. +Defined. + +Lemma isequiv_functor_forall `{P : A -> Type} `{Q : B -> Type} + `{IsEquiv B A f} `{forall b, @IsEquiv (P (f b)) (Q b) (g b)} +: (forall b : B, Q b) -> forall a : A, P a. +Proof. + refine (functor_forall + (f^-1) + (fun (x:A) (y:Q (f^-1 x)) => eisretr f x # (g (f^-1 x))^-1 y)). +Defined. (* was: Error: Attempt to save an incomplete proof *) diff --git a/test-suite/bugs/closed/bug_3849.v b/test-suite/bugs/closed/bug_3849.v new file mode 100644 index 0000000000..a8dc3af9cf --- /dev/null +++ b/test-suite/bugs/closed/bug_3849.v @@ -0,0 +1,8 @@ +Tactic Notation "foo" hyp_list(hs) := clear hs. + +Tactic Notation "bar" hyp_list(hs) := foo hs. + +Goal True. +do 5 pose proof 0 as ?n0. +foo n1 n2. +bar n3 n4. diff --git a/test-suite/bugs/closed/bug_3854.v b/test-suite/bugs/closed/bug_3854.v new file mode 100644 index 0000000000..7e915f202b --- /dev/null +++ b/test-suite/bugs/closed/bug_3854.v @@ -0,0 +1,22 @@ +Require Import TestSuite.admit. +Definition relation (A : Type) := A -> A -> Type. +Class Reflexive {A} (R : relation A) := reflexivity : forall x : A, R x x. +Axiom IsHProp : Type -> Type. +Existing Class IsHProp. +Inductive Empty : Set := . +Notation "~ x" := (x -> Empty) : type_scope. +Record hProp := BuildhProp { type :> Type ; trunc : IsHProp type }. +Arguments BuildhProp _ {_}. +Canonical Structure default_hProp := fun T P => (@BuildhProp T P). +Generalizable Variables A B f g e n. +Axiom trunc_forall : forall `{P : A -> Type}, IsHProp (forall a, P a). +Existing Instance trunc_forall. +Inductive V : Type := | set {A : Type} (f : A -> V) : V. +Axiom mem : V -> V -> hProp. +Axiom mem_induction +: forall (C : V -> hProp), (forall v, (forall x, mem x v -> C x) -> C v) -> forall v, C v. +Definition irreflexive_mem : forall x, (fun x y => ~ mem x y) x x. +Proof. + pose (fun x => BuildhProp (~ mem x x)). + refine (mem_induction (fun x => BuildhProp (~ mem x x)) _); simpl in *. + admit. diff --git a/test-suite/bugs/closed/bug_3881.v b/test-suite/bugs/closed/bug_3881.v new file mode 100644 index 0000000000..d7e097e326 --- /dev/null +++ b/test-suite/bugs/closed/bug_3881.v @@ -0,0 +1,34 @@ +(* -*- coq-prog-args: ("-nois" "-R" "../theories" "Coq") -*- *) +(* File reduced by coq-bug-finder from original input, then from 2236 lines to 1877 lines, then from 1652 lines to 160 lines, then from 102 lines to 34 lines *) +(* coqc version trunk (December 2014) compiled on Dec 23 2014 22:6:43 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (90ed6636dea41486ddf2cc0daead83f9f0788163) *) +Generalizable All Variables. +Require Import Coq.Init.Notations. +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Axiom admit : forall {T}, T. +Notation "g 'o' f" := (fun x => g (f x)) (at level 40, left associativity). +Notation "g 'o' f" := ltac:(let g' := g in let f' := f in exact (fun x => g' (f' x))) (at level 40, left associativity). (* Ensure that x is not captured in [g] or [f] in case they contain holes *) +Inductive eq {A} (x:A) : A -> Prop := eq_refl : x = x where "x = y" := (@eq _ x y) : type_scope. +Arguments eq_refl {_ _}. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with eq_refl => eq_refl end. +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : forall x, f (equiv_inv x) = x }. +Arguments eisretr {A B} f {_} _. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'"). +Global Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} : IsEquiv (g o f) | 1000 := admit. +Definition isequiv_homotopic {A B} (f : A -> B) (g : A -> B) `{IsEquiv A B f} (h : forall x, f x = g x) : IsEquiv g := admit. +Global Instance isequiv_inverse {A B} (f : A -> B) {feq : IsEquiv f} : IsEquiv f^-1 | 10000 := admit. +Definition cancelR_isequiv {A B C} (f : A -> B) {g : B -> C} `{IsEquiv A B f} `{IsEquiv A C (g o f)} : IsEquiv g. +Proof. + pose (fun H => @isequiv_homotopic _ _ ((g o f) o f^-1) _ H + (fun b => ap g (eisretr f b))) as k. + revert k. + let x := match goal with |- let k := ?x in _ => constr:(x) end in + intro k; clear k; + pose (x _). + pose (@isequiv_homotopic _ _ ((g o f) o f^-1) g _ + (fun b => ap g (eisretr f b))). + Undo. + apply (@isequiv_homotopic _ _ ((g o f) o f^-1) g _ + (fun b => ap g (eisretr f b))). +Qed. diff --git a/test-suite/bugs/closed/bug_3886.v b/test-suite/bugs/closed/bug_3886.v new file mode 100644 index 0000000000..b523b117e5 --- /dev/null +++ b/test-suite/bugs/closed/bug_3886.v @@ -0,0 +1,23 @@ +Require Import Program. + +Inductive Even : nat -> Prop := +| evenO : Even O +| evenS : forall n, Odd n -> Even (S n) +with Odd : nat -> Prop := +| oddS : forall n, Even n -> Odd (S n). + +Program Fixpoint doubleE {n} (e : Even n) : Even (2 * n) + := _ +with doubleO {n} (o : Odd n) : Odd (S (2 * n)) + := _. +Obligations. +Axiom cheat : forall {A}, A. +Obligation 1 of doubleE. +apply cheat. +Qed. + +Obligation 1 of doubleO. +apply cheat. +Qed. + +Check doubleE. diff --git a/test-suite/bugs/closed/bug_3892.v b/test-suite/bugs/closed/bug_3892.v new file mode 100644 index 0000000000..833722ba9a --- /dev/null +++ b/test-suite/bugs/closed/bug_3892.v @@ -0,0 +1,8 @@ +(* Check that notation variables do not capture names hidden behind + another notation. *) +Notation "A <-> B" := ((A -> B) * (B -> A))%type : type_scope. +Notation compose := (fun g f x => g (f x)). +Notation "g 'o' f" := (compose g f) (at level 40, left associativity). +Definition iff_compose {A B C : Type} (g : B <-> C) (f : A <-> B) : A <-> C := + (fst g o fst f , snd f o snd g). +(* Used to fail with: This expression should be a name. *) diff --git a/test-suite/bugs/closed/bug_3895.v b/test-suite/bugs/closed/bug_3895.v new file mode 100644 index 0000000000..8659ca2cbd --- /dev/null +++ b/test-suite/bugs/closed/bug_3895.v @@ -0,0 +1,22 @@ +Notation pr1 := (@projT1 _ _). +Notation compose := (fun g' f' x => g' (f' x)). +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : +function_scope. +Open Scope function_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p +with eq_refl => eq_refl end. +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) := forall x:A, +f x = g x. +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : +type_scope. +Theorem Univalence_implies_FunextNondep (A B : Type) +: forall f g : A -> B, f == g -> f = g. +Proof. + intros f g p. + pose (d := fun x : A => existT (fun xy => fst xy = snd xy) (f x, f x) +(eq_refl (f x))). + pose (e := fun x : A => existT (fun xy => fst xy = snd xy) (f x, g x) (p x)). + change f with ((snd o pr1) o d). + change g with ((snd o pr1) o e). + apply (ap (fun g => snd o pr1 o g)). +(* Used to raise a not Found due to a "typo" in solve_evar_evar *) diff --git a/test-suite/bugs/closed/bug_3896.v b/test-suite/bugs/closed/bug_3896.v new file mode 100644 index 0000000000..b433922a21 --- /dev/null +++ b/test-suite/bugs/closed/bug_3896.v @@ -0,0 +1,4 @@ +Goal True. +pose proof 0 as n. +Fail apply pair in n. +(* Used to be an anomaly for a while *) diff --git a/test-suite/bugs/closed/bug_3899.v b/test-suite/bugs/closed/bug_3899.v new file mode 100644 index 0000000000..7754934c0b --- /dev/null +++ b/test-suite/bugs/closed/bug_3899.v @@ -0,0 +1,11 @@ +Set Primitive Projections. +Record unit : Set := tt {}. +Fail Check fun x : unit => eq_refl : tt = x. +Fail Check fun x : unit => eq_refl : x = tt. +Fail Check fun x y : unit => (eq_refl : x = tt) : x = y. +Fail Check fun x y : unit => eq_refl : x = y. + +Record ok : Set := tt' { a : unit }. + +Record nonprim : Prop := { undef : unit }. +Record prim : Prop := { def : True }. diff --git a/test-suite/bugs/closed/bug_3900.v b/test-suite/bugs/closed/bug_3900.v new file mode 100644 index 0000000000..6be2161c2f --- /dev/null +++ b/test-suite/bugs/closed/bug_3900.v @@ -0,0 +1,13 @@ +Global Set Primitive Projections. +Set Implicit Arguments. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Variable A : PreCategory. +Variable Pobj : A -> Type. +Local Notation obj := (sigT Pobj). +Variable Pmor : forall s d : obj, morphism A (projT1 s) (projT1 d) -> Type. +Class Foo (x : Type) := { _ : forall y, y }. +Local Instance ishset_pmor {s d m} : Foo (Pmor s d m). +Proof. +SearchAbout ((forall _ _, _) -> Foo _). +Abort. diff --git a/test-suite/bugs/closed/bug_3911.v b/test-suite/bugs/closed/bug_3911.v new file mode 100644 index 0000000000..de728213d4 --- /dev/null +++ b/test-suite/bugs/closed/bug_3911.v @@ -0,0 +1,26 @@ +(* Tested against coq ee596bc *) + +Set Nonrecursive Elimination Schemes. +Set Primitive Projections. +Set Universe Polymorphism. + +Record setoid := { base : Type }. + +Definition catdata (Obj Arr : Type) : Type := nat. + (* [nat] can be replaced by any other type, it seems, + without changing the error *) + +Record cat : Type := + { + obj : setoid; + arr : Type; + dta : catdata (base obj) arr + }. + +Definition bcwa (C:cat) (B:setoid) :Type := nat. + (* As above, nothing special about [nat] here. *) + +Record temp {C}{B} (e:bcwa C B) := + { fld : base (obj C) }. + +Print temp_rect. diff --git a/test-suite/bugs/closed/bug_3916.v b/test-suite/bugs/closed/bug_3916.v new file mode 100644 index 0000000000..9d8da11017 --- /dev/null +++ b/test-suite/bugs/closed/bug_3916.v @@ -0,0 +1,2 @@ +Require Import List. +Fail Hint Resolve -> in_map. diff --git a/test-suite/bugs/closed/bug_3920.v b/test-suite/bugs/closed/bug_3920.v new file mode 100644 index 0000000000..a4adb23cc2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3920.v @@ -0,0 +1,7 @@ +Require Import Setoid. +Axiom P : nat -> Prop. +Axiom P_or : forall x y, P (x + y) <-> P x \/ P y. +Lemma foo (H : P 3) : False. +eapply or_introl in H. +erewrite <- P_or in H. +(* Error: No such hypothesis: H *) diff --git a/test-suite/bugs/closed/bug_3922.v b/test-suite/bugs/closed/bug_3922.v new file mode 100644 index 0000000000..d88e8c3325 --- /dev/null +++ b/test-suite/bugs/closed/bug_3922.v @@ -0,0 +1,85 @@ +Unset Strict Universe Declaration. +Require Import TestSuite.admit. +Set Universe Polymorphism. +Notation Type0 := Set. + +Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. +Open Scope function_scope. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) +}. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. +Local Open Scope trunc_scope. +Notation "-2" := minus_two (at level 0) : trunc_scope. +Notation "-1" := (-2.+1) (at level 0) : trunc_scope. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | -2 => Contr_internal A + | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Notation Contr := (IsTrunc -2). +Notation IsHProp := (IsTrunc -1). + +Monomorphic Axiom dummy_funext_type : Type0. +Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. + +Inductive Unit : Set := + tt : Unit. + +Record TruncType (n : trunc_index) := BuildTruncType { + trunctype_type : Type ; + istrunc_trunctype_type : IsTrunc n trunctype_type +}. + +Arguments BuildTruncType _ _ {_}. + +Coercion trunctype_type : TruncType >-> Sortclass. + +Notation "n -Type" := (TruncType n) (at level 1) : type_scope. +Notation hProp := (-1)-Type. + +Notation BuildhProp := (BuildTruncType -1). + +Private Inductive Trunc (n : trunc_index) (A :Type) : Type := + tr : A -> Trunc n A. +Arguments tr {n A} a. + +Global Instance istrunc_truncation (n : trunc_index) (A : Type@{i}) +: IsTrunc@{j} n (Trunc@{i} n A). +Admitted. + +Definition Trunc_ind {n A} + (P : Trunc n A -> Type) {Pt : forall aa, IsTrunc n (P aa)} + : (forall a, P (tr a)) -> (forall aa, P aa) +:= (fun f aa => match aa with tr a => fun _ => f a end Pt). +Definition merely (A : Type@{i}) : hProp := BuildhProp (Trunc -1 A). +Definition cconst_factors_contr `{Funext} {X Y : Type} (f : X -> Y) + (P : Type) `{Pc : X -> Contr P} + (g : X -> P) (h : P -> Y) (p : h o g == f) +: Unit. +Proof. + assert (merely X -> IsHProp P) by admit. + refine (let g' := Trunc_ind (fun _ => P) g : merely X -> P in _); + [ assumption.. | ]. + pose (g'' := Trunc_ind (fun _ => P) g : merely X -> P). diff --git a/test-suite/bugs/closed/bug_3923.v b/test-suite/bugs/closed/bug_3923.v new file mode 100644 index 0000000000..1d9488c6e1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3923.v @@ -0,0 +1,36 @@ +Require Coq.extraction.Extraction. + +Module Type TRIVIAL. +Parameter t:Type. +End TRIVIAL. + +Module MkStore (Key : TRIVIAL). + +Module St : TRIVIAL. +Definition t := unit. +End St. + +End MkStore. + + + +Module Type CERTRUNTIMETYPES (B : TRIVIAL). + +Parameter cert_fieldstore : Type. +Parameter empty_fieldstore : cert_fieldstore. + +End CERTRUNTIMETYPES. + + + +Module MkCertRuntimeTypes (B : TRIVIAL) : CERTRUNTIMETYPES B. + +Module FieldStore := MkStore B. + +Definition cert_fieldstore := FieldStore.St.t. +Axiom empty_fieldstore : cert_fieldstore. + +End MkCertRuntimeTypes. + +Extraction MkCertRuntimeTypes. (* Was leading to an uncaught Not_found *) +Extraction TestCompile MkCertRuntimeTypes. diff --git a/test-suite/bugs/closed/bug_3929.v b/test-suite/bugs/closed/bug_3929.v new file mode 100644 index 0000000000..e65a8252cc --- /dev/null +++ b/test-suite/bugs/closed/bug_3929.v @@ -0,0 +1,67 @@ +Universes i j. +Set Printing Universes. +Set Printing All. +Polymorphic Definition lt@{x y} : Type@{y} := Type@{x}. +Goal True. +evar (T:Type@{i}). +set (Z := nat : Type@{j}). simpl in Z. +let Tv:=eval cbv [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +(** This enforces i <= j *) +Fail pose (lt@{i j}). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +exact I. +Defined. + +Goal True. +evar (T:nat). +pose (Z:=0). +let Tv:=eval cbv [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +Abort. + +Goal True. +evar (T:Set). +pose (Z:=nat). +let Tv:=eval cbv [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +Abort. + +Goal forall (A:Type)(a:A), True. +intros A a. +evar (T:A). +pose (Z:=a). +let Tv:=eval cbv delta [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +Abort. + +Goal True. +evar (T:Type). +pose (Z:=nat). +let Tv:=eval cbv [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +Abort. diff --git a/test-suite/bugs/closed/bug_3938.v b/test-suite/bugs/closed/bug_3938.v new file mode 100644 index 0000000000..35db82bd4c --- /dev/null +++ b/test-suite/bugs/closed/bug_3938.v @@ -0,0 +1,8 @@ +Require Import TestSuite.admit. +Require Import Coq.Arith.PeanoNat. +Hint Extern 1 => admit : typeclass_instances. +Require Import Setoid. +Goal forall a b (f : nat -> Set) (R : nat -> nat -> Prop), + Equivalence R -> R a b -> f a = f b. + intros a b f H. + intros. Fail rewrite H1. diff --git a/test-suite/bugs/closed/bug_3943.v b/test-suite/bugs/closed/bug_3943.v new file mode 100644 index 0000000000..ac9c50369b --- /dev/null +++ b/test-suite/bugs/closed/bug_3943.v @@ -0,0 +1,50 @@ +(* File reduced by coq-bug-finder from original input, then from 9492 lines to 119 lines *) +(* coqc version 8.5beta1 (January 2015) compiled on Jan 18 2015 7:27:36 with OCaml 3.12.1 + coqtop version 8.5beta1 (January 2015) *) + +Set Typeclasses Dependency Order. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y" := (@paths _ x y) : type_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Set Implicit Arguments. +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. + +Record PreCategory := Build_PreCategory' { + object :> Type; + morphism : object -> object -> Type; + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' }. +Arguments identity {!C%category} / x%object : rename. +Arguments compose {!C%category} / {s d d'}%object (m1 m2)%morphism : rename. + +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { + morphism_inverse : morphism C d s; + left_inverse : compose morphism_inverse m = identity _; + right_inverse : compose m morphism_inverse = identity _ }. +Arguments morphism_inverse {C s d} m {_}. +Local Notation "m ^-1" := (morphism_inverse m) (at level 3, format "m '^-1'") : morphism_scope. + +Class Isomorphic {C : PreCategory} s d := { + morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. +Coercion morphism_isomorphic : Isomorphic >-> morphism. + +Variable C : PreCategory. +Variables s d : C. + +Definition path_isomorphic (i j : Isomorphic s d) +: @morphism_isomorphic _ _ _ i = @morphism_isomorphic _ _ _ j -> i = j. +Admitted. + +Definition ap_morphism_inverse_path_isomorphic (i j : Isomorphic s d) p q +: ap (fun e : Isomorphic s d => e^-1)%morphism (path_isomorphic i j p) = q. diff --git a/test-suite/bugs/closed/bug_3944.v b/test-suite/bugs/closed/bug_3944.v new file mode 100644 index 0000000000..58e60f4f2e --- /dev/null +++ b/test-suite/bugs/closed/bug_3944.v @@ -0,0 +1,5 @@ +Require Import Setoid. +Definition C (T : Type) := T. +Goal forall T (i : C T) (v : T), True. +Proof. +Fail setoid_rewrite plus_n_Sm. diff --git a/test-suite/bugs/closed/bug_3948.v b/test-suite/bugs/closed/bug_3948.v new file mode 100644 index 0000000000..56b1e3ffb4 --- /dev/null +++ b/test-suite/bugs/closed/bug_3948.v @@ -0,0 +1,24 @@ +Module Type S. +Parameter t : Type. +End S. + +Module Bar(X : S). +Definition elt := X.t. +Axiom fold : elt. +End Bar. + +Module Make (Z: S) := Bar(Z). + +Declare Module Y : S. + +Module Type Interface. +Parameter constant : unit. +End Interface. + +Module DepMap : Interface. +Module Dom := Make(Y). +Definition constant : unit := + let _ := @Dom.fold in tt. +End DepMap. + +Print Assumptions DepMap.constant. diff --git a/test-suite/bugs/closed/bug_3953.v b/test-suite/bugs/closed/bug_3953.v new file mode 100644 index 0000000000..167cecea8e --- /dev/null +++ b/test-suite/bugs/closed/bug_3953.v @@ -0,0 +1,5 @@ +(* Checking subst on instances of evars (was bugged in 8.5 beta 1) *) +Goal forall (a b : unit), a = b -> exists c, b = c. + intros. + eexists. + subst. diff --git a/test-suite/bugs/closed/bug_3956.v b/test-suite/bugs/closed/bug_3956.v new file mode 100644 index 0000000000..115284ec02 --- /dev/null +++ b/test-suite/bugs/closed/bug_3956.v @@ -0,0 +1,143 @@ +(* -*- mode: coq; coq-prog-args: ("-indices-matter"); mode: visual-line -*- *) +Set Universe Polymorphism. +Set Primitive Projections. +Close Scope nat_scope. + +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Arguments pair {A B} _ _. +Arguments fst {A B} _ / . +Arguments snd {A B} _ / . +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. + +Unset Strict Universe Declaration. + +Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. +Definition Type2 := Eval hnf in let gt := (Type1 : Type@{i}) in Type@{i}. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y" := (@paths _ x y) : type_scope. +Definition concat {A} {x y z : A} (p : x = y) (q : y = z) : x = z + := match p, q with idpath, idpath => idpath end. + +Definition path_prod {A B : Type} (z z' : A * B) +: (fst z = fst z') -> (snd z = snd z') -> (z = z'). +Proof. + destruct z, z'; simpl; intros [] []; reflexivity. +Defined. + +Module Type TypeM. + Parameter m : Type2. +End TypeM. + +Module ProdM (XM : TypeM) (YM : TypeM) <: TypeM. + Definition m := XM.m * YM.m. +End ProdM. + +Module Type FunctionM (XM YM : TypeM). + Parameter m : XM.m -> YM.m. +End FunctionM. + +Module IdmapM (XM : TypeM) <: FunctionM XM XM. + Definition m := (fun x => x) : XM.m -> XM.m. +End IdmapM. + +Module Type HomotopyM (XM YM : TypeM) (fM gM : FunctionM XM YM). + Parameter m : forall x, fM.m x = gM.m x. +End HomotopyM. + +Module ComposeM (XM YM ZM : TypeM) + (gM : FunctionM YM ZM) (fM : FunctionM XM YM) + <: FunctionM XM ZM. + Definition m := (fun x => gM.m (fM.m x)). +End ComposeM. + +Module Type CorecM (YM ZM : TypeM) (fM : FunctionM YM ZM) + (XM : TypeM) (gM : FunctionM XM ZM). + Parameter m : XM.m -> YM.m. + Parameter m_beta : forall x, fM.m (m x) = gM.m x. +End CorecM. + +Module Type CoindpathsM (YM ZM : TypeM) (fM : FunctionM YM ZM) + (XM : TypeM) (hM kM : FunctionM XM YM). + Module fhM := ComposeM XM YM ZM fM hM. + Module fkM := ComposeM XM YM ZM fM kM. + Declare Module mM (pM : HomotopyM XM ZM fhM fkM) + : HomotopyM XM YM hM kM. +End CoindpathsM. + +Module Type Comodality (XM : TypeM). + Parameter m : Type2. + Module mM <: TypeM. + Definition m := m. + End mM. + Parameter from : m -> XM.m. + Module fromM <: FunctionM mM XM. + Definition m := from. + End fromM. + Declare Module corecM : CorecM mM XM fromM. + Declare Module coindpathsM : CoindpathsM mM XM fromM. +End Comodality. + +Module Comodality_Theory (F : Comodality). + + Module F_functor_M (XM YM : TypeM) (fM : FunctionM XM YM) + (FXM : Comodality XM) (FYM : Comodality YM). + Module f_o_from_M <: FunctionM FXM.mM YM. + Definition m := fun x => fM.m (FXM.from x). + End f_o_from_M. + Module mM := FYM.corecM FXM.mM f_o_from_M. + Definition m := mM.m. + End F_functor_M. + + Module F_prod_cmp_M (XM YM : TypeM) + (FXM : Comodality XM) (FYM : Comodality YM). + Module PM := ProdM XM YM. + Module PFM := ProdM FXM FYM. + Module fstM <: FunctionM PM XM. + Definition m := @fst XM.m YM.m. + End fstM. + Module sndM <: FunctionM PM YM. + Definition m := @snd XM.m YM.m. + End sndM. + Module FPM := F PM. + Module FfstM := F_functor_M PM XM fstM FPM FXM. + Module FsndM := F_functor_M PM YM sndM FPM FYM. + Definition m : FPM.m -> PFM.m + := fun z => (FfstM.m z , FsndM.m z). + End F_prod_cmp_M. + + Module isequiv_F_prod_cmp_M + (XM YM : TypeM) + (FXM : Comodality XM) (FYM : Comodality YM). + (** The comparison map *) + Module cmpM := F_prod_cmp_M XM YM FXM FYM. + Module FPM := cmpM.FPM. + (** We construct an inverse to it using corecursion. *) + Module prod_from_M <: FunctionM cmpM.PFM cmpM.PM. + Definition m : cmpM.PFM.m -> cmpM.PM.m + := fun z => ( FXM.from (fst z) , FYM.from (snd z) ). + End prod_from_M. + Module cmpinvM <: FunctionM cmpM.PFM FPM + := FPM.corecM cmpM.PFM prod_from_M. + (** We prove the first homotopy *) + Module cmpinv_o_cmp_M <: FunctionM FPM FPM + := ComposeM FPM cmpM.PFM FPM cmpinvM cmpM. + Module idmap_FPM <: FunctionM FPM FPM + := IdmapM FPM. + Module cip_FPM := FPM.coindpathsM FPM cmpinv_o_cmp_M idmap_FPM. + Module cip_FPHM <: HomotopyM FPM cmpM.PM cip_FPM.fhM cip_FPM.fkM. + Definition m : forall x, cip_FPM.fhM.m@{i j} x = cip_FPM.fkM.m@{i j} x. + Proof. + intros x. + refine (concat (cmpinvM.m_beta@{i j} (cmpM.m@{i j} x)) _). + apply path_prod@{i i i}; simpl. + - exact (cmpM.FfstM.mM.m_beta@{i j} x). + - exact (cmpM.FsndM.mM.m_beta@{i j} x). + Defined. + End cip_FPHM. + End isequiv_F_prod_cmp_M. + +End Comodality_Theory. diff --git a/test-suite/bugs/closed/bug_3957.v b/test-suite/bugs/closed/bug_3957.v new file mode 100644 index 0000000000..e20a6e97f0 --- /dev/null +++ b/test-suite/bugs/closed/bug_3957.v @@ -0,0 +1,6 @@ +Ltac foo tac := tac. + +Goal True. +Proof. +foo subst. +Admitted. diff --git a/test-suite/bugs/closed/bug_3960.v b/test-suite/bugs/closed/bug_3960.v new file mode 100644 index 0000000000..3527312486 --- /dev/null +++ b/test-suite/bugs/closed/bug_3960.v @@ -0,0 +1,26 @@ +Require Program.Tactics. + +Axiom foo : nat -> Prop. + +Axiom fooP : forall n, foo n. + +Class myClass (A: Type) := + { + bar : A -> Prop + }. + +Program Instance myInstance : myClass nat := + { + bar := foo + }. + +Class myClassP (A : Type) := + { + super :> myClass A; + barP : forall (a : A), bar a + }. + +Instance myInstanceP : myClassP nat := + { + barP := fooP + }. diff --git a/test-suite/bugs/closed/bug_3974.v b/test-suite/bugs/closed/bug_3974.v new file mode 100644 index 0000000000..3d9e06b612 --- /dev/null +++ b/test-suite/bugs/closed/bug_3974.v @@ -0,0 +1,7 @@ +Module Type S. +End S. + +Module Type M (X : S). + Fail Module P (X : S). + (* Used to say: Anomaly: X already exists. Please report. *) + (* Should rather say now: Error: X already exists. *) diff --git a/test-suite/bugs/closed/bug_3975.v b/test-suite/bugs/closed/bug_3975.v new file mode 100644 index 0000000000..c7616b3ab6 --- /dev/null +++ b/test-suite/bugs/closed/bug_3975.v @@ -0,0 +1,8 @@ +Module Type S. End S. + +Module M (X:S). End M. + +Module Type P (X : S). + Print M. + (* Used to say: Anomaly: X already exists. Please report. *) + (* Should rather : print something :-) *) diff --git a/test-suite/bugs/closed/bug_3978.v b/test-suite/bugs/closed/bug_3978.v new file mode 100644 index 0000000000..5606bf1c7e --- /dev/null +++ b/test-suite/bugs/closed/bug_3978.v @@ -0,0 +1,27 @@ +Require Import Structures.OrderedType. +Require Import Structures.OrderedTypeEx. + +Module Type M. Parameter X : Type. + +Declare Module Export XOrd : OrderedType + with Definition t := X + with Definition eq := @Logic.eq X. +End M. + +Module M' : M. + Definition X := nat. + + Module XOrd := Nat_as_OT. +End M'. + +Module Type MyOt. + Parameter t : Type. + Parameter eq : t -> t -> Prop. +End MyOt. + +Module Type M2. Parameter X : Type. + +Declare Module Export XOrd : MyOt + with Definition t := X + with Definition eq := @Logic.eq X. +End M2. diff --git a/test-suite/bugs/closed/bug_3993.v b/test-suite/bugs/closed/bug_3993.v new file mode 100644 index 0000000000..086d8dd0f3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3993.v @@ -0,0 +1,3 @@ +(* Test smooth failure on not fully applied term to destruct with eqn: given *) +Goal True. +Fail induction S eqn:H. diff --git a/test-suite/bugs/closed/bug_3998.v b/test-suite/bugs/closed/bug_3998.v new file mode 100644 index 0000000000..e17550e904 --- /dev/null +++ b/test-suite/bugs/closed/bug_3998.v @@ -0,0 +1,24 @@ +Class FieldType (F : Set) := mkFieldType { fldTy: F -> Set }. +Hint Mode FieldType + : typeclass_instances. (* The F parameter is an input *) + +Inductive I1 := C. +Inductive I2 := . + +Instance I1FieldType : FieldType I1 := { fldTy := I1_rect _ bool }. +Instance I2FieldType : FieldType I2 := { fldTy := I2_rect _ }. + +Definition RecordOf F (FT: FieldType F) := forall f:F, fldTy f. + +Class MapOps (M K : Set) := { + tgtTy: K -> Set; + update: M -> forall k:K, tgtTy k -> M +}. + +Instance RecordMapOps F (FT: FieldType F) : MapOps (RecordOf F FT) F := +{ tgtTy := fldTy; update := fun r (f: F) (x: fldTy f) z => r z }. + +Axiom ex : RecordOf _ I1FieldType. + +Definition works := (fun ex' => update ex' C true) (update ex C false). +Set Typeclasses Debug. +Definition doesnt := update (update ex C false) C true. diff --git a/test-suite/bugs/closed/bug_4001.v b/test-suite/bugs/closed/bug_4001.v new file mode 100644 index 0000000000..25ce692318 --- /dev/null +++ b/test-suite/bugs/closed/bug_4001.v @@ -0,0 +1,18 @@ +(* Computing the type constraints to be satisfied when building the + return clause of a match with a match *) + +Set Implicit Arguments. +Set Asymmetric Patterns. + +Variable A : Type. +Variable typ : A -> Type. + +Inductive t : list A -> Type := +| snil : t nil +| scons : forall (x : A) (e : typ x) (lx : list A) (le : t lx), t (x::lx). + +Definition car (x:A) (lx : list A) (s: t (x::lx)) : typ x := + match s in t l' with + | snil => False + | scons _ e _ _ => e + end. diff --git a/test-suite/bugs/closed/bug_4012.v b/test-suite/bugs/closed/bug_4012.v new file mode 100644 index 0000000000..1748e3baad --- /dev/null +++ b/test-suite/bugs/closed/bug_4012.v @@ -0,0 +1,5 @@ +Goal (forall T : Type, T = T) -> Type. +Proof. + intro H. + Fail specialize (H _). +Abort. diff --git a/test-suite/bugs/closed/bug_4016.v b/test-suite/bugs/closed/bug_4016.v new file mode 100644 index 0000000000..c1c9aa673c --- /dev/null +++ b/test-suite/bugs/closed/bug_4016.v @@ -0,0 +1,11 @@ +Require Import Setoid. + +Parameter eq : relation nat. +Declare Instance Equivalence_eq : Equivalence eq. + +Lemma foo : forall z, eq z 0 -> forall x, eq x 0 -> eq z x. +Proof. +intros z Hz x Hx. +rewrite <- Hx in Hz. +destruct z. +Abort. diff --git a/test-suite/bugs/closed/bug_4017.v b/test-suite/bugs/closed/bug_4017.v new file mode 100644 index 0000000000..90d4fc7d22 --- /dev/null +++ b/test-suite/bugs/closed/bug_4017.v @@ -0,0 +1,8 @@ +Set Implicit Arguments. + +(* Use of implicit arguments was lost in multiple variable declarations *) +Variables + (A1 : Type) + (A2 : forall (x1 : A1), Type) + (A3 : forall (x1 : A1) (x2 : A2 x1), Type) + (A4 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type). diff --git a/test-suite/bugs/closed/bug_4018.v b/test-suite/bugs/closed/bug_4018.v new file mode 100644 index 0000000000..8895e09e02 --- /dev/null +++ b/test-suite/bugs/closed/bug_4018.v @@ -0,0 +1,3 @@ +(* Catching PatternMatchingFailure was lost at some point *) +Goal nat -> True. +Fail intros [=]. diff --git a/test-suite/bugs/closed/bug_4031.v b/test-suite/bugs/closed/bug_4031.v new file mode 100644 index 0000000000..d2d86a9d13 --- /dev/null +++ b/test-suite/bugs/closed/bug_4031.v @@ -0,0 +1,14 @@ +Definition something (P:Type) (e:P) := e. + +Inductive myunit : Set := mytt. + (* Proof below works when definition is in Type, + however builtin types such as unit are in Set. *) + +Lemma demo_hide_generic : + let x := mytt in x = x. +Proof. + intros. + change mytt with (@something _ mytt) in x. + subst x. (* Proof works if this line is removed *) + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_4034.v b/test-suite/bugs/closed/bug_4034.v new file mode 100644 index 0000000000..3f7be4d1c7 --- /dev/null +++ b/test-suite/bugs/closed/bug_4034.v @@ -0,0 +1,25 @@ +(* This checks compatibility of interpretation scope used for exact + between 8.4 and 8.5. See discussion at + https://coq.inria.fr/bugs/show_bug.cgi?id=4034. It is not clear + what we would like exactly, but certainly, if exact is interpreted + in a special scope, it should be interpreted consistently so also + in ltac code. *) + +Record Foo := {}. +Bind Scope foo_scope with Foo. +Notation "!" := Build_Foo : foo_scope. +Notation "!" := 1 : core_scope. +Open Scope foo_scope. +Open Scope core_scope. + +Goal Foo. + Fail exact !. +(* ... but maybe will we want it to succeed eventually if we ever + would be able to make it working the same in + +Ltac myexact e := exact e. + +Goal Foo. + myexact !. +Defined. +*) diff --git a/test-suite/bugs/closed/bug_4035.v b/test-suite/bugs/closed/bug_4035.v new file mode 100644 index 0000000000..ec246d097b --- /dev/null +++ b/test-suite/bugs/closed/bug_4035.v @@ -0,0 +1,13 @@ +(* Supporting tactic notations within Ltac in the presence of an + "ident" entry which does not expect a fresh ident *) +(* Of course, this is a matter of convention of what "ident" is + supposed to denote, but in practice, it seems more convenient to + have less constraints on ident at interpretation time, as + otherwise more ad hoc entries would be necessary (as e.g. a special + "quantified_hypothesis" entry for dependent destruction). *) +Require Import Program. +Goal nat -> Type. + intro x. + lazymatch goal with + | [ x : nat |- _ ] => dependent destruction x + end. diff --git a/test-suite/bugs/closed/bug_4046.v b/test-suite/bugs/closed/bug_4046.v new file mode 100644 index 0000000000..c33e2b9feb --- /dev/null +++ b/test-suite/bugs/closed/bug_4046.v @@ -0,0 +1,6 @@ +Module Import Foo. + Class Foo := { foo : Type }. +End Foo. + +Instance f : Foo := { foo := nat }. (* works fine *) +Instance f' : Foo.Foo := { Foo.foo := nat }. diff --git a/test-suite/bugs/closed/bug_4057.v b/test-suite/bugs/closed/bug_4057.v new file mode 100644 index 0000000000..5b2e56f261 --- /dev/null +++ b/test-suite/bugs/closed/bug_4057.v @@ -0,0 +1,210 @@ +Require Coq.Strings.String. + +Set Implicit Arguments. + +Axiom falso : False. +Ltac admit := destruct falso. + +Reserved Notation "[ x ]". + +Record string_like (CharType : Type) := + { + String :> Type; + Singleton : CharType -> String where "[ x ]" := (Singleton x); + Empty : String; + Concat : String -> String -> String where "x ++ y" := (Concat x y); + bool_eq : String -> String -> bool; + bool_eq_correct : forall x y : String, bool_eq x y = true <-> x = y; + Length : String -> nat + }. + +Delimit Scope string_like_scope with string_like. +Bind Scope string_like_scope with String. +Arguments Length {_%type_scope _} _%string_like. +Infix "++" := (@Concat _ _) : string_like_scope. + +Definition str_le {CharType} {String : string_like CharType} (s1 s2 : String) + := Length s1 < Length s2 \/ s1 = s2. +Infix "≤s" := str_le (at level 70, right associativity). + +Module Export ContextFreeGrammar. + Import Coq.Strings.String. + Import Coq.Lists.List. + + Section cfg. + Variable CharType : Type. + + Section definitions. + + Inductive item := + | NonTerminal (name : string). + + Definition production := list item. + Definition productions := list production. + + Record grammar := + { + Start_symbol :> string; + Lookup :> string -> productions + }. + End definitions. + + Section parse. + Variable String : string_like CharType. + Variable G : grammar. + + Inductive parse_of : String -> productions -> Type := + | ParseHead : forall str pat pats, parse_of_production str pat + -> parse_of str (pat::pats) + | ParseTail : forall str pat pats, parse_of str pats + -> parse_of str (pat::pats) + with parse_of_production : String -> production -> Type := + | ParseProductionCons : forall str pat strs pats, + parse_of_item str pat + -> parse_of_production strs pats + -> parse_of_production (str ++ strs) (pat::pats) + with parse_of_item : String -> item -> Type := + | ParseNonTerminal : forall name str, parse_of str (Lookup G name) + -> parse_of_item str (NonTerminal +name). + End parse. + End cfg. + +End ContextFreeGrammar. +Module Export ContextFreeGrammarProperties. + + Section cfg. + Context CharType (String : string_like CharType) (G : grammar) + (P : String.string -> Type). + + Fixpoint Forall_parse_of {str pats} (p : parse_of String G str pats) + := match p with + | @ParseHead _ _ _ str pat pats p' + => Forall_parse_of_production p' + | @ParseTail _ _ _ _ _ _ p' + => Forall_parse_of p' + end + with Forall_parse_of_production {str pat} (p : parse_of_production String G +str pat) + := let Forall_parse_of_item {str it} (p : parse_of_item String G str +it) + := match p return Type with + | @ParseNonTerminal _ _ _ name str p' + => (P name * Forall_parse_of p')%type + end in + match p return Type with + | @ParseProductionCons _ _ _ str pat strs pats p' p'' + => (Forall_parse_of_item p' * Forall_parse_of_production +p'')%type + end. + + Definition Forall_parse_of_item {str it} (p : parse_of_item String G str it) + := match p return Type with + | @ParseNonTerminal _ _ _ name str p' + => (P name * Forall_parse_of p')%type + end. + End cfg. + +End ContextFreeGrammarProperties. + +Module Export DependentlyTyped. + Import Coq.Strings.String. + + Section recursive_descent_parser. + + Class parser_computational_predataT := + { nonterminal_names_listT : Type; + initial_nonterminal_names_data : nonterminal_names_listT; + is_valid_nonterminal_name : nonterminal_names_listT -> string -> bool; + remove_nonterminal_name : nonterminal_names_listT -> string -> +nonterminal_names_listT }. + + End recursive_descent_parser. + +End DependentlyTyped. +Import Coq.Strings.String. +Import Coq.Lists.List. + +Section cfg. + Context CharType (String : string_like CharType) (G : grammar). + Context (names_listT : Type) + (initial_names_data : names_listT) + (is_valid_name : names_listT -> string -> bool) + (remove_name : names_listT -> string -> names_listT). + + Inductive minimal_parse_of + : forall (str0 : String) (valid : names_listT) + (str : String), + productions -> Type := + | MinParseHead : forall str0 valid str pat pats, + @minimal_parse_of_production str0 valid str pat + -> @minimal_parse_of str0 valid str (pat::pats) + | MinParseTail : forall str0 valid str pat pats, + @minimal_parse_of str0 valid str pats + -> @minimal_parse_of str0 valid str (pat::pats) + with minimal_parse_of_production + : forall (str0 : String) (valid : names_listT) + (str : String), + production -> Type := + | MinParseProductionNil : forall str0 valid, + @minimal_parse_of_production str0 valid (Empty _) +nil + | MinParseProductionCons : forall str0 valid str strs pat pats, + str ++ strs ≤s str0 + -> @minimal_parse_of_item str0 valid str pat + -> @minimal_parse_of_production str0 valid strs +pats + -> @minimal_parse_of_production str0 valid (str +++ strs) (pat::pats) + with minimal_parse_of_item + : forall (str0 : String) (valid : names_listT) + (str : String), + item -> Type := + | MinParseNonTerminal + : forall str0 valid str name, + @minimal_parse_of_name str0 valid str name + -> @minimal_parse_of_item str0 valid str (NonTerminal name) + with minimal_parse_of_name + : forall (str0 : String) (valid : names_listT) + (str : String), + string -> Type := + | MinParseNonTerminalStrLt + : forall str0 valid name str, + @minimal_parse_of str initial_names_data str (Lookup G name) + -> @minimal_parse_of_name str0 valid str name + | MinParseNonTerminalStrEq + : forall str valid name, + @minimal_parse_of str (remove_name valid name) str (Lookup G name) + -> @minimal_parse_of_name str valid str name. + Definition parse_of_item_name__of__minimal_parse_of_name + : forall {str0 valid str name} (p : @minimal_parse_of_name str0 valid str +name), + parse_of_item String G str (NonTerminal name). + Proof. + admit. + Defined. + +End cfg. + +Section recursive_descent_parser. + Context (CharType : Type) + (String : string_like CharType) + (G : grammar). + Context {premethods : parser_computational_predataT}. + Let P : string -> Prop. + Proof. + admit. + Defined. + + Let mp_parse_nonterminal_name str0 valid str nonterminal_name + := { p' : minimal_parse_of_name String G initial_nonterminal_names_data +remove_nonterminal_name str0 valid str nonterminal_name & Forall_parse_of_item +P (parse_of_item_name__of__minimal_parse_of_name p') }. + + Goal False. + Proof. + clear -mp_parse_nonterminal_name. + subst P. + simpl in *. + admit. + Qed. diff --git a/test-suite/bugs/closed/bug_4069.v b/test-suite/bugs/closed/bug_4069.v new file mode 100644 index 0000000000..69d5bc6c03 --- /dev/null +++ b/test-suite/bugs/closed/bug_4069.v @@ -0,0 +1,106 @@ + +Lemma test1 : +forall (v : nat) (f g : nat -> nat), +f v = g v. +intros. f_equal. +(* +Goal in v8.5: f v = g v +Goal in v8.4: v = v -> f v = g v +Expected: f = g +*) +Admitted. + +Lemma test2 : +forall (v u : nat) (f g : nat -> nat), +f v = g u. +intros. f_equal. +(* +In both v8.4 And v8.5 +Goal 1: v = u -> f v = g u +Goal 2: v = u + +Expected Goal 1: f = g +Expected Goal 2: v = u +*) +Admitted. + +Lemma test3 : +forall (v : nat) (u : list nat) (f : nat -> nat) (g : list nat -> nat), +f v = g u. +intros. f_equal. +(* +In both v8.4 And v8.5, the goal is unchanged. +*) +Admitted. + +Require Import List. +Lemma foo n (l k : list nat) : k ++ skipn n l = skipn n l. +Proof. f_equal. +(* + 8.4: leaves the goal unchanged, i.e. k ++ skipn n l = skipn n l + 8.5: 2 goals, skipn n l = l -> k ++ skipn n l = skipn n l + and skipn n l = l +*) +Abort. + +Require Import List. +Fixpoint replicate {A} (n : nat) (x : A) : list A := + match n with 0 => nil | S n => x :: replicate n x end. +Lemma bar {A} n m (x : A) : + skipn n (replicate m x) = replicate (m - n) x -> + skipn n (replicate m x) = replicate (m - n) x. +Proof. intros. f_equal. +(* 8.5: one goal, n = m - n *) +Abort. + +Variable F : nat -> Set. +Variable X : forall n, F (n + 1). + +Definition sequator{X Y: Set}{eq:X=Y}(x:X) : Y := eq_rec _ _ x _ eq. +Definition tequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq. +Polymorphic Definition pequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq. + +Goal {n:nat & F (S n)}. +eexists. +unshelve eapply (sequator (X _)). +f_equal. (*behaves*) +Undo 2. +unshelve eapply (pequator (X _)). +f_equal. (*behaves*) +Undo 2. +unshelve eapply (tequator (X _)). +f_equal. (*behaves now *) +Focus 2. exact 0. +simpl. +reflexivity. +Defined. + +(* Part 2: modulo casts introduced by refine due to reductions in goals *) + +Goal {n:nat & F (S n)}. +eexists. +(*misbehaves, although same goal as above*) +Set Printing All. +unshelve refine (sequator (X _)); revgoals. +2:exact 0. reflexivity. +Undo 3. +unshelve refine (pequator (X _)); revgoals. +f_equal. +Undo 2. +unshelve refine (tequator (X _)); revgoals. +f_equal. +Admitted. + +Goal @eq Set nat nat. +congruence. +Qed. + +Goal @eq Type nat nat. +congruence. +Qed. + +Variable T : Type. + +Goal @eq Type T T. +congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_4078.v b/test-suite/bugs/closed/bug_4078.v new file mode 100644 index 0000000000..236cd2fbb1 --- /dev/null +++ b/test-suite/bugs/closed/bug_4078.v @@ -0,0 +1,14 @@ +Module Type S. + +Axiom foo : nat. + +End S. + +Module M : S. + +Definition bar := 0. +Definition foo := bar. + +End M. + +Print All Dependencies M.foo. diff --git a/test-suite/bugs/closed/bug_4089.v b/test-suite/bugs/closed/bug_4089.v new file mode 100644 index 0000000000..fc1c504f14 --- /dev/null +++ b/test-suite/bugs/closed/bug_4089.v @@ -0,0 +1,375 @@ +Unset Strict Universe Declaration. +Require Import TestSuite.admit. +(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 6522 lines to 318 lines, then from 1139 lines to 361 lines *) +(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) +Open Scope type_scope. + +Global Set Universe Polymorphism. +Module Export Datatypes. + +Set Implicit Arguments. + +Record prod (A B : Type) := pair { fst : A ; snd : B }. + +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. + +End Datatypes. +Module Export Specif. + +Set Implicit Arguments. + +Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. + +Notation sigT := sig (only parsing). +Notation existT := exist (only parsing). + +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. + +Notation projT1 := proj1_sig (only parsing). +Notation projT2 := proj2_sig (only parsing). + +End Specif. + +Ltac rapply p := + refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _) || + refine (p _ _ _ _ _) || + refine (p _ _ _ _) || + refine (p _ _ _) || + refine (p _ _) || + refine (p _) || + refine p. + +Local Unset Elimination Schemes. + +Definition relation (A : Type) := A -> A -> Type. + +Class Symmetric {A} (R : relation A) := + symmetry : forall x y, R x y -> R y x. + +Class Transitive {A} (R : relation A) := + transitivity : forall x y z, R x y -> R y z -> R x z. + +Tactic Notation "etransitivity" open_constr(y) := + let R := match goal with |- ?R ?x ?z => constr:(R) end in + let x := match goal with |- ?R ?x ?z => constr:(x) end in + let z := match goal with |- ?R ?x ?z => constr:(z) end in + let pre_proof_term_head := constr:(@transitivity _ R _) in + let proof_term_head := (eval cbn in pre_proof_term_head) in + refine (proof_term_head x y z _ _); [ change (R x y) | change (R y z) ]. + +Ltac transitivity x := etransitivity x. + +Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. + +Notation idmap := (fun x => x). +Delimit Scope function_scope with function. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Open Scope fibration_scope. +Open Scope function_scope. + +Notation "( x ; y )" := (existT _ x y) : fibration_scope. + +Notation pr1 := projT1. +Notation pr2 := projT2. + +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Scheme paths_ind := Induction for paths Sort Type. + +Definition paths_rect := paths_ind. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Local Open Scope path_scope. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Arguments concat {A x y z} p q : simpl nomatch. + +Notation "1" := idpath : path_scope. + +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. + +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. + +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) + : f == g + := fun x => match h with idpath => 1 end. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) +}. + +Arguments eisretr {A B}%type_scope f%function_scope {_} _. +Arguments eissect {A B}%type_scope f%function_scope {_} _. +Arguments eisadj {A B}%type_scope f%function_scope {_} _. + +Record Equiv A B := BuildEquiv { + equiv_fun : A -> B ; + equiv_isequiv : IsEquiv equiv_fun +}. + +Coercion equiv_fun : Equiv >-> Funclass. + +Global Existing Instance equiv_isequiv. + +Bind Scope equiv_scope with Equiv. + +Notation "A <~> B" := (Equiv A B) (at level 85) : type_scope. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. + +Inductive Unit : Set := + tt : Unit. + +Ltac done := + trivial; intros; solve + [ repeat first + [ solve [trivial] + | solve [symmetry; trivial] + | reflexivity + + | contradiction + | split ] + | match goal with + H : ~ _ |- _ => solve [destruct H; trivial] + end ]. +Tactic Notation "by" tactic(tac) := + tac; done. + +Definition concat_p1 {A : Type} {x y : A} (p : x = y) : + p @ 1 = p + := + match p with idpath => 1 end. + +Definition concat_1p {A : Type} {x y : A} (p : x = y) : + 1 @ p = p + := + match p with idpath => 1 end. + +Definition ap_pp {A B : Type} (f : A -> B) {x y z : A} (p : x = y) (q : y = z) : + ap f (p @ q) = (ap f p) @ (ap f q) + := + match q with + idpath => + match p with idpath => 1 end + end. + +Definition ap_compose {A B C : Type} (f : A -> B) (g : B -> C) {x y : A} (p : x = y) : + ap (g o f) p = ap g (ap f p) + := + match p with idpath => 1 end. + +Definition concat_A1p {A : Type} {f : A -> A} (p : forall x, f x = x) {x y : A} (q : x = y) : + (ap f q) @ (p y) = (p x) @ q + := + match q with + | idpath => concat_1p _ @ ((concat_p1 _) ^) + end. + +Definition concat2 {A} {x y z : A} {p p' : x = y} {q q' : y = z} (h : p = p') (h' : q = q') + : p @ q = p' @ q' +:= match h, h' with idpath, idpath => 1 end. + +Notation "p @@ q" := (concat2 p q)%path (at level 20) : path_scope. + +Definition whiskerL {A : Type} {x y z : A} (p : x = y) + {q r : y = z} (h : q = r) : p @ q = p @ r +:= 1 @@ h. + +Definition ap02 {A B : Type} (f:A->B) {x y:A} {p q:x=y} (r:p=q) : ap f p = ap f q + := match r with idpath => 1 end. +Module Export Equivalences. + +Generalizable Variables A B C f g. + +Global Instance isequiv_idmap (A : Type) : IsEquiv idmap | 0 := + BuildIsEquiv A A idmap idmap (fun _ => 1) (fun _ => 1) (fun _ => 1). + +Definition equiv_idmap (A : Type) : A <~> A := BuildEquiv A A idmap _. + +Arguments equiv_idmap {A} , A. + +Notation "1" := equiv_idmap : equiv_scope. + +Global Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} + : IsEquiv (compose g f) | 1000 + := BuildIsEquiv A C (compose g f) + (compose f^-1 g^-1) + (fun c => ap g (eisretr f (g^-1 c)) @ eisretr g c) + (fun a => ap (f^-1) (eissect g (f a)) @ eissect f a) + (fun a => + (whiskerL _ (eisadj g (f a))) @ + (ap_pp g _ _)^ @ + ap02 g + ( (concat_A1p (eisretr f) (eissect g (f a)))^ @ + (ap_compose f^-1 f _ @@ eisadj f a) @ + (ap_pp f _ _)^ + ) @ + (ap_compose f g _)^ + ). + +Definition equiv_compose {A B C : Type} (g : B -> C) (f : A -> B) + `{IsEquiv B C g} `{IsEquiv A B f} + : A <~> C + := BuildEquiv A C (compose g f) _. + +Global Instance transitive_equiv : Transitive Equiv | 0 := + fun _ _ _ f g => equiv_compose g f. + +Theorem equiv_inverse {A B : Type} : (A <~> B) -> (B <~> A). +admit. +Defined. + +Global Instance symmetric_equiv : Symmetric Equiv | 0 := @equiv_inverse. + +End Equivalences. + +Definition path_prod_uncurried {A B : Type} (z z' : A * B) + (pq : (fst z = fst z') * (snd z = snd z')) + : (z = z'). +admit. +Defined. + +Global Instance isequiv_path_prod {A B : Type} {z z' : A * B} +: IsEquiv (path_prod_uncurried z z') | 0. +admit. +Defined. + +Definition equiv_path_prod {A B : Type} (z z' : A * B) + : (fst z = fst z') * (snd z = snd z') <~> (z = z') + := BuildEquiv _ _ (path_prod_uncurried z z') _. + +Generalizable Variables X A B C f g n. + +Definition functor_sigma `{P : A -> Type} `{Q : B -> Type} + (f : A -> B) (g : forall a, P a -> Q (f a)) +: sigT P -> sigT Q + := fun u => (f u.1 ; g u.1 u.2). + +Global Instance isequiv_functor_sigma `{P : A -> Type} `{Q : B -> Type} + `{IsEquiv A B f} `{forall a, @IsEquiv (P a) (Q (f a)) (g a)} +: IsEquiv (functor_sigma f g) | 1000. +admit. +Defined. + +Definition equiv_functor_sigma `{P : A -> Type} `{Q : B -> Type} + (f : A -> B) `{IsEquiv A B f} + (g : forall a, P a -> Q (f a)) + `{forall a, @IsEquiv (P a) (Q (f a)) (g a)} +: sigT P <~> sigT Q + := BuildEquiv _ _ (functor_sigma f g) _. + +Definition equiv_functor_sigma' `{P : A -> Type} `{Q : B -> Type} + (f : A <~> B) + (g : forall a, P a <~> Q (f a)) +: sigT P <~> sigT Q + := equiv_functor_sigma f g. + +Definition equiv_functor_sigma_id `{P : A -> Type} `{Q : A -> Type} + (g : forall a, P a <~> Q a) +: sigT P <~> sigT Q + := equiv_functor_sigma' 1 g. + +Definition Bip : Type := { C : Type & C * C }. + +Definition BipMor (X Y : Bip) : Type := + match X, Y with (C;(c0,c1)), (D;(d0,d1)) => + { f : C -> D & (f c0 = d0) * (f c1 = d1) } + end. + +Definition bipmor2map {X Y : Bip} : BipMor X Y -> X.1 -> Y.1 := + match X, Y with (C;(c0,c1)), (D;(d0,d1)) => fun i => + match i with (f;_) => f end + end. + +Definition bipidmor {X : Bip} : BipMor X X := + match X with (C;(c0,c1)) => (idmap; (1, 1)) end. + +Definition bipcompmor {X Y Z : Bip} : BipMor X Y -> BipMor Y Z -> BipMor X Z := + match X, Y, Z with (C;(c0,c1)), (D;(d0,d1)), (E;(e0,e1)) => fun i j => + match i, j with (f;(f0,f1)), (g;(g0,g1)) => + (g o f; (ap g f0 @ g0, ap g f1 @ g1)) + end + end. + +Definition isbipequiv {X Y : Bip} (i : BipMor X Y) : Type := + { l : BipMor Y X & bipcompmor i l = bipidmor } * + { r : BipMor Y X & bipcompmor r i = bipidmor }. + +Lemma bipequivEQequiv : forall {X Y : Bip} (i : BipMor X Y), + isbipequiv i <~> IsEquiv (bipmor2map i). +Proof. +assert (equivcompmor : forall {X Y : Bip} (i : BipMor X Y) j, +(bipcompmor i j = bipidmor) <~> Unit). + intros; set (U := X); set (V := Y); destruct X as [C [c0 c1]], Y as [D [d0 d1]]. + transitivity { n : (bipcompmor i j).1 = (@bipidmor U).1 & + (bipcompmor i j).2 = transport (fun h => (h c0 = c0) * (h c1 = c1)) n^ (@bipidmor U).2}. + admit. + destruct i as [f [f0 f1]]; destruct j as [g [g0 g1]]. + + transitivity { n : g o f = idmap & (ap g f0 @ g0 = apD10 n c0 @ 1) * + (ap g f1 @ g1 = apD10 n c1 @ 1)}. + apply equiv_functor_sigma_id; intro n. + assert (Ggen : forall (h0 h1 : C -> C) (p : h0 = h1) u0 u1 v0 v1, + ((u0, u1) = transport (fun h => (h c0 = c0) * (h c1 = c1)) p^ (v0, v1)) <~> + (u0 = apD10 p c0 @ v0) * (u1 = apD10 p c1 @ v1)). + induction p; intros; simpl; rewrite !concat_1p; apply symmetry. + by apply (equiv_path_prod (u0,u1) (v0,v1)). + rapply Ggen. + pose (@paths C). + Check (@paths C). + Undo. + Check (@paths C). (* Toplevel input, characters 0-17: +Error: Illegal application: +The term "@paths" of type "forall A : Type, A -> A -> Type" +cannot be applied to the term + "C" : "Type" +This term has type "Type@{Top.892}" which should be coercible to + "Type@{Top.882}". +*) diff --git a/test-suite/bugs/closed/bug_4095.v b/test-suite/bugs/closed/bug_4095.v new file mode 100644 index 0000000000..bc9380f90d --- /dev/null +++ b/test-suite/bugs/closed/bug_4095.v @@ -0,0 +1,87 @@ +(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines, then from 92 lines to 79 lines *) +(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) +Require Import Coq.Setoids.Setoid. +Generalizable All Variables. +Axiom admit : forall {T}, T. +Ltac admit := apply admit. +Class Equiv (A : Type) := equiv : relation A. +Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. +Class ILogicOps Frm := { lentails: relation Frm; + ltrue: Frm; + land: Frm -> Frm -> Frm; + lor: Frm -> Frm -> Frm }. +Infix "|--" := lentails (at level 79, no associativity). +Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }. +Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P. +Infix "-|-" := lequiv (at level 85, no associativity). +Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit. +Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }. +Section ILogic_Fun. + Context (T: Type) `{TType: type T}. + Context `{IL: ILogic Frm}. + Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. + Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. +End ILogic_Fun. +Arguments ILFunFrm _ {e} _ {ILOps}. +Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; + ltrue := True; + land P Q := P /\ Q; + lor P Q := P \/ Q |}. +Axiom Action : Set. +Definition Actions := list Action. +Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }. +Definition OPred := ILFunFrm Actions Prop. +Local Existing Instance ILFun_Ops. +Local Existing Instance ILFun_ILogic. +Definition catOP (P Q: OPred) : OPred := admit. +Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. +admit. +Defined. +Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. +Class IsPointed (T : Type) := point : T. +Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). +Record PointedOPred := mkPointedOPred { + OPred_pred :> OPred; + OPred_inhabited: IsPointed_OPred OPred_pred + }. +Existing Instance OPred_inhabited. +Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred + := {| OPred_pred := O ; OPred_inhabited := _ |}. +Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit. +Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) + (tr : T -> T) (O2 : PointedOPred) (x : T) + (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0), + exists e1 e2, + catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2. + intros; do 2 esplit. + rewrite <- catOPA. + lazymatch goal with + | |- ?R (?f ?a ?b) (?f ?a' ?b') => + let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred) + (@Morphisms.respectful OPred (OPred -> OPred) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop)) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==> + @lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP + catOP_entails_m_Proper a a' H b b' H') in + pose P; + refine (P _ _) + end. + Undo. + Fail lazymatch goal with + | |- ?R (?f ?a ?b) (?f ?a' ?b') => + let P := constr:(fun H H' => Morphisms.proper_prf a a' H b b' H') in + set(p:=P) + end. (* Toplevel input, characters 15-182: +Error: Cannot infer an instance of type +"PointedOPred" for the variable p in environment: +T : Type +O0 : T -> OPred +O1 : T -> PointedOPred +tr : T -> T +O2 : PointedOPred +x0 : T +H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0 *) diff --git a/test-suite/bugs/closed/bug_4097.v b/test-suite/bugs/closed/bug_4097.v new file mode 100644 index 0000000000..183b860d1f --- /dev/null +++ b/test-suite/bugs/closed/bug_4097.v @@ -0,0 +1,65 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 6082 lines to 81 lines, then from 436 lines to 93 lines *) +(* coqc version 8.5beta1 (February 2015) compiled on Feb 27 2015 15:10:37 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (fc1b3ef9d7270938cd83c524aae0383093b7a4b5) *) +Global Set Primitive Projections. +Record sigT {A} (P : A -> Type) := exist { projT1 : A ; projT2 : P projT1 }. +Arguments projT1 {A P} _ / . +Arguments projT2 {A P} _ / . +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Open Scope path_scope. +Open Scope fibration_scope. +Notation "( x ; y )" := (exist _ _ x y) : fibration_scope. +Notation pr1 := projT1. +Notation pr2 := projT2. +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. +Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): + p # (f x) = f y + := + match p with idpath => idpath end. +Lemma transport_compose {A B} {x y : A} (P : B -> Type) (f : A -> B) + (p : x = y) (z : P (f x)) + : transport (fun x => P (f x)) p z = transport P (ap f p) z. +admit. +Defined. +Generalizable Variables X A B C f g n. +Definition pr1_path `{P : A -> Type} {u v : sigT P} (p : u = v) +: u.1 = v.1 + := ap pr1 p. +Notation "p ..1" := (pr1_path p) (at level 3) : fibration_scope. +Definition pr2_path `{P : A -> Type} {u v : sigT P} (p : u = v) +: p..1 # u.2 = v.2 + := (transport_compose P pr1 p u.2)^ + @ (@apD {x:A & P x} _ pr2 _ _ p). +Notation "p ..2" := (pr2_path p) (at level 3) : fibration_scope. +Definition path_path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (p q : u = v) + (rs : {r : p..1 = q..1 & transport (fun x => transport P x u.2 = v.2) r p..2 = q..2}) +: p = q. +admit. +Defined. +Set Debug Unification. +Definition path_path_sigma {A : Type} (P : A -> Type) (u v : sigT P) + (p q : u = v) + (r : p..1 = q..1) + (s : transport (fun x => transport P x u.2 = v.2) r p..2 = q..2) +: p = q + := path_path_sigma_uncurried P u v p q (r; s). diff --git a/test-suite/bugs/closed/bug_4101.v b/test-suite/bugs/closed/bug_4101.v new file mode 100644 index 0000000000..b7c3e372aa --- /dev/null +++ b/test-suite/bugs/closed/bug_4101.v @@ -0,0 +1,19 @@ +(* File reduced by coq-bug-finder from original input, then from 10940 lines to 152 lines, then from 509 lines to 163 lines, then from 178 lines to 66 lines *) +(* coqc version 8.5beta1 (March 2015) compiled on Mar 2 2015 18:53:10 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (e77f178e60918f14eacd1ec0364a491d4cfd0f3f) *) + +Global Set Primitive Projections. +Set Implicit Arguments. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), + (forall x, f x = g x) -> f = g. +Lemma sigT_obj_eq +: forall (T : Type) (T0 : T -> Type) + (s s0 : forall s : sigT T0, + sigT (fun _ : T0 (projT1 s) => unit) -> + sigT (fun _ : T0 (projT1 s) => unit)), + s0 = s. +Proof. + intros. + Set Debug Tactic Unification. + apply path_forall. diff --git a/test-suite/bugs/closed/bug_4103.v b/test-suite/bugs/closed/bug_4103.v new file mode 100644 index 0000000000..92cc0279ac --- /dev/null +++ b/test-suite/bugs/closed/bug_4103.v @@ -0,0 +1,12 @@ +Set Primitive Projections. + +CoInductive stream A := { hd : A; tl : stream A }. + +CoFixpoint ticks (n : nat) : stream unit := {| hd := tt; tl := ticks n |}. + +Lemma expand : exists n : nat, (ticks n) = (ticks n).(tl _). +Proof. + eexists. + (* Set Debug Tactic Unification. *) + (* Set Debug RAKAM. *) + reflexivity. diff --git a/test-suite/bugs/closed/bug_4116.v b/test-suite/bugs/closed/bug_4116.v new file mode 100644 index 0000000000..5932c9c56e --- /dev/null +++ b/test-suite/bugs/closed/bug_4116.v @@ -0,0 +1,383 @@ +(* File reduced by coq-bug-finder from original input, then from 13191 lines to 1315 lines, then from 1601 lines to 595 lines, then from 585 lines to 379 lines *) +(* coqc version 8.5beta1 (March 2015) compiled on Mar 3 2015 3:50:31 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ac62cda8a4f488b94033b108c37556877232137a) *) + +Axiom admit : False. +Ltac admit := exfalso; exact admit. + +Global Set Primitive Projections. + +Notation projT1 := proj1_sig (only parsing). +Notation projT2 := proj2_sig (only parsing). + +Definition relation (A : Type) := A -> A -> Type. + +Class Reflexive {A} (R : relation A) := + reflexivity : forall x : A, R x x. + +Class Symmetric {A} (R : relation A) := + symmetry : forall x y, R x y -> R y x. + +Notation idmap := (fun x => x). +Delimit Scope function_scope with function. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Open Scope path_scope. +Open Scope fibration_scope. +Open Scope function_scope. + +Notation pr1 := projT1. +Notation pr2 := projT2. + +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Global Instance symmetric_paths {A} : Symmetric (@paths A) | 0 := @inverse A. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Notation "1" := idpath : path_scope. + +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. + +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. + +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) +: f == g + := fun x => match h with idpath => 1 end. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) + }. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) + }. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. +Local Open Scope trunc_scope. +Notation "-2" := minus_two (at level 0) : trunc_scope. +Notation "-1" := (-2.+1) (at level 0) : trunc_scope. +Notation "0" := (-1.+1) : trunc_scope. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | -2 => Contr_internal A + | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Tactic Notation "transparent" "assert" "(" ident(name) ":" constr(type) ")" := + unshelve refine (let __transparent_assert_hypothesis := (_ : type) in _); + [ + | ( + let H := match goal with H := _ |- _ => constr:(H) end in + rename H into name) ]. + +Definition transport_idmap_ap A (P : A -> Type) x y (p : x = y) (u : P x) +: transport P p u = transport idmap (ap P p) u + := match p with idpath => idpath end. + +Section Adjointify. + + Context {A B : Type} (f : A -> B) (g : B -> A). + Context (isretr : Sect g f) (issect : Sect f g). + + Let issect' := fun x => + ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. + + Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). + admit. + Defined. + + Definition isequiv_adjointify : IsEquiv f + := BuildIsEquiv A B f g isretr issect' is_adjoint'. + +End Adjointify. + +Record TruncType (n : trunc_index) := BuildTruncType { + trunctype_type : Type ; + istrunc_trunctype_type : IsTrunc n trunctype_type + }. +Arguments trunctype_type {_} _. + +Coercion trunctype_type : TruncType >-> Sortclass. + +Notation "n -Type" := (TruncType n) (at level 1) : type_scope. +Notation hSet := 0-Type. + +Module Export Category. + Module Export Core. + Set Implicit Arguments. + + Delimit Scope morphism_scope with morphism. + Delimit Scope category_scope with category. + Delimit Scope object_scope with object. + + Record PreCategory := + Build_PreCategory' { + object :> Type; + morphism : object -> object -> Type; + + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g); + + associativity : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + (m3 o m2) o m1 = m3 o (m2 o m1); + + associativity_sym : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + m3 o (m2 o m1) = (m3 o m2) o m1; + + left_identity : forall a b (f : morphism a b), identity b o f = f; + right_identity : forall a b (f : morphism a b), f o identity a = f; + + identity_identity : forall x, identity x o identity x = identity x + }. + Arguments identity {!C%category} / x%object : rename. + Arguments compose {!C%category} / {s d d'}%object (m1 m2)%morphism : rename. + + Definition Build_PreCategory + object morphism compose identity + associativity left_identity right_identity + := @Build_PreCategory' + object + morphism + compose + identity + associativity + (fun _ _ _ _ _ _ _ => symmetry _ _ (associativity _ _ _ _ _ _ _)) + left_identity + right_identity + (fun _ => left_identity _ _ _). + + Module Export CategoryCoreNotations. + Infix "o" := compose : morphism_scope. + Notation "1" := (identity _) : morphism_scope. + End CategoryCoreNotations. + + End Core. + +End Category. +Module Export Core. + Set Implicit Arguments. + + Delimit Scope functor_scope with functor. + + Local Open Scope morphism_scope. + + Section Functor. + Variables C D : PreCategory. + + Record Functor := + { + object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d); + composition_of : forall s d d' + (m1 : morphism C s d) (m2: morphism C d d'), + morphism_of _ _ (m2 o m1) + = (morphism_of _ _ m2) o (morphism_of _ _ m1); + identity_of : forall x, morphism_of _ _ (identity x) + = identity (object_of x) + }. + End Functor. + Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. + +End Core. +Module Export Morphisms. + Set Implicit Arguments. + + Local Open Scope category_scope. + Local Open Scope morphism_scope. + + Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := + { + morphism_inverse : morphism C d s; + left_inverse : morphism_inverse o m = identity _; + right_inverse : m o morphism_inverse = identity _ + }. + + Class Isomorphic {C : PreCategory} s d := + { + morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic + }. + + Coercion morphism_isomorphic : Isomorphic >-> morphism. + + Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. + + Section iso_equiv_relation. + Variable C : PreCategory. + + Global Instance isisomorphism_identity (x : C) : IsIsomorphism (identity x) + := {| morphism_inverse := identity x; + left_inverse := left_identity C x x (identity x); + right_inverse := right_identity C x x (identity x) |}. + + Global Instance isomorphic_refl : Reflexive (@Isomorphic C) + := fun x : C => {| morphism_isomorphic := identity x |}. + + Definition idtoiso (x y : C) (H : x = y) : Isomorphic x y + := match H in (_ = y0) return (x <~=~> y0) with + | 1%path => reflexivity x + end. + End iso_equiv_relation. + +End Morphisms. + +Notation IsCategory C := (forall s d : object C, IsEquiv (@idtoiso C s d)). + +Notation isotoid C s d := (@equiv_inv _ _ (@idtoiso C s d) _). + +Notation cat_of obj := + (@Build_PreCategory obj + (fun x y => x -> y) + (fun _ x => x) + (fun _ _ _ f g => f o g)%core + (fun _ _ _ _ _ _ _ => idpath) + (fun _ _ _ => idpath) + (fun _ _ _ => idpath) + ). +Definition set_cat : PreCategory := cat_of hSet. +Set Implicit Arguments. + +Local Open Scope morphism_scope. + +Section Grothendieck. + Variable C : PreCategory. + Variable F : Functor C set_cat. + + Record Pair := + { + c : C; + x : F c + }. + + Local Notation Gmorphism s d := + { f : morphism C s.(c) d.(c) + | morphism_of F f s.(x) = d.(x) }. + + Definition identity_H s + := apD10 (identity_of F s.(c)) s.(x). + + Definition Gidentity s : Gmorphism s s. + Proof. + exists 1. + apply identity_H. + Defined. + + Definition Gcategory : PreCategory. + Proof. + unshelve refine (@Build_PreCategory + Pair + (fun s d => Gmorphism s d) + Gidentity + _ + _ + _ + _); admit. + Defined. +End Grothendieck. + +Lemma isotoid_1 {C} `{IsCategory C} {x : C} {H : IsIsomorphism (identity x)} +: isotoid C x x {| morphism_isomorphic := (identity x) ; isisomorphism_isomorphic := H |} + = idpath. + admit. +Defined. +Generalizable All Variables. + +Section Grothendieck2. + Context `{IsCategory C}. + Variable F : Functor C set_cat. + + Instance iscategory_grothendieck_toset : IsCategory (Gcategory F). + Proof. + intros s d. + unshelve refine (isequiv_adjointify _ _ _ _). + { + intro m. + transparent assert (H' : (s.(c) = d.(c))). + { + apply (idtoiso C (x := s.(c)) (y := d.(c)))^-1%function. + exists (m : morphism _ _ _).1. + admit. + + } + { + transitivity {| x := transport (fun x => F x) H' s.(x) |}. + admit. + + { + change d with {| c := d.(c) ; x := d.(x) |}; simpl. + apply ap. + subst H'. + simpl. + refine (transport_idmap_ap _ (fun x => F x : Type) _ _ _ _ @ _ @ (m : morphism _ _ _).2). + change (fun x => F x : Type) with (trunctype_type o object_of F)%function. + admit. + } + } + } + { + admit. + } + + { + intro x. + hnf in s, d. + destruct x. + simpl. + erewrite @isotoid_1. diff --git a/test-suite/bugs/closed/bug_4120.v b/test-suite/bugs/closed/bug_4120.v new file mode 100644 index 0000000000..315dc0d242 --- /dev/null +++ b/test-suite/bugs/closed/bug_4120.v @@ -0,0 +1,5 @@ +Definition id {T} (x : T) := x. +Goal sigT (fun x => id x)%type. + change (fun x => ?f x) with f. + exists Type. exact Set. +Defined. (* Error: Attempt to save a proof with shelved goals (in proof Unnamed_thm) *) diff --git a/test-suite/bugs/closed/bug_4121.v b/test-suite/bugs/closed/bug_4121.v new file mode 100644 index 0000000000..b236846710 --- /dev/null +++ b/test-suite/bugs/closed/bug_4121.v @@ -0,0 +1,18 @@ +Unset Strict Universe Declaration. +(* -*- coq-prog-args: ("-nois") -*- *) +(* File reduced by coq-bug-finder from original input, then from 830 lines to 47 lines, then from 25 lines to 11 lines *) +(* coqc version 8.5beta1 (March 2015) compiled on Mar 11 2015 18:51:36 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (8dbfee5c5f897af8186cb1bdfb04fd4f88eca677) *) + +Declare ML Module "ltac_plugin". + +Set Universe Polymorphism. +Class Contr_internal (A : Type) := BuildContr { center : A }. +Arguments center A {_}. +Class Contr (A : Type) : Type := Contr_is_trunc : Contr_internal A. +Hint Extern 0 => progress change Contr_internal with Contr in * : typeclass_instances. +Definition contr_paths_contr0 {A} `{Contr A} : Contr A := {| center := center A |}. +Instance contr_paths_contr1 {A} `{Contr A} : Contr A := {| center := center A |}. +Check @contr_paths_contr0@{i}. +Check @contr_paths_contr1@{i}. (* Error: Universe instance should have length 2 *) +(** It should have length 1, just like contr_paths_contr0 *) diff --git a/test-suite/bugs/closed/bug_4132.v b/test-suite/bugs/closed/bug_4132.v new file mode 100644 index 0000000000..806ffb771f --- /dev/null +++ b/test-suite/bugs/closed/bug_4132.v @@ -0,0 +1,31 @@ + +Require Import ZArith Omega. +Open Scope Z_scope. + +(** bug 4132: omega was using "simpl" either on whole equations, or on + delimited but wrong spots. This was leading to unexpected reductions + when one atom (here [b]) is an evaluable reference instead of a variable. *) + +Lemma foo + (x y x' zxy zxy' z : Z) + (b := 5) + (Ry : - b <= y < b) + (Bx : x' <= b) + (H : - zxy' <= zxy) + (H' : zxy' <= x') : - b <= zxy. +Proof. +omega. (* was: Uncaught exception Invalid_argument("index out of bounds"). *) +Qed. + +Lemma foo2 x y (b := 5) (H1 : x <= y) (H2 : y <= b) : x <= b. +omega. (* Pierre L: according to a comment of bug report #4132, + this might have triggered "index out of bounds" in the past, + but I never managed to reproduce that in any version, + even before my fix. *) +Qed. + +Lemma foo3 x y (b := 0) (H1 : x <= y) (H2 : y <= b) : x <= b. +omega. (* Pierre L: according to a comment of bug report #4132, + this might have triggered "Failure(occurence 2)" in the past, + but I never managed to reproduce that. *) +Qed. diff --git a/test-suite/bugs/closed/bug_4149.v b/test-suite/bugs/closed/bug_4149.v new file mode 100644 index 0000000000..b81c680cd7 --- /dev/null +++ b/test-suite/bugs/closed/bug_4149.v @@ -0,0 +1,4 @@ +Goal forall A, A -> Type. +Proof. + intros; eauto. +Qed. diff --git a/test-suite/bugs/closed/bug_4151.v b/test-suite/bugs/closed/bug_4151.v new file mode 100644 index 0000000000..fc0b58cfe1 --- /dev/null +++ b/test-suite/bugs/closed/bug_4151.v @@ -0,0 +1,403 @@ +Lemma foo (H : forall A, A) : forall A, A. + Show Universes. + eexact H. +Qed. + +(* File reduced by coq-bug-finder from original input, then from 6390 lines to 397 lines *) +(* coqc version 8.5beta1 (March 2015) compiled on Mar 17 2015 12:34:25 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (1b3759e78f227eb85a128c58b8ce8c11509dd8c3) *) +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Import Coq.Lists.SetoidList. +Require Export Coq.Program.Program. + +Global Set Implicit Arguments. +Global Set Asymmetric Patterns. + +Fixpoint combine_sig_helper {T} {P : T -> Prop} (ls : list T) : (forall x, In x ls -> P x) -> list (sig P). + admit. +Defined. + +Lemma Forall_forall1_transparent_helper_1 {A P} {x : A} {xs : list A} {l : list A} + (H : Forall P l) (H' : x::xs = l) +: P x. + admit. +Defined. +Lemma Forall_forall1_transparent_helper_2 {A P} {x : A} {xs : list A} {l : list A} + (H : Forall P l) (H' : x::xs = l) +: Forall P xs. + admit. +Defined. + +Fixpoint Forall_forall1_transparent {A} (P : A -> Prop) (l : list A) {struct l} +: Forall P l -> forall x, In x l -> P x + := match l as l return Forall P l -> forall x, In x l -> P x with + | nil => fun _ _ f => match f : False with end + | x::xs => fun H x' H' => + match H' with + | or_introl H'' => eq_rect x + P + (Forall_forall1_transparent_helper_1 H eq_refl) + _ + H'' + | or_intror H'' => @Forall_forall1_transparent A P xs (Forall_forall1_transparent_helper_2 H eq_refl) _ H'' + end + end. + +Definition combine_sig {T P ls} (H : List.Forall P ls) : list (@sig T P) + := combine_sig_helper ls (@Forall_forall1_transparent T P ls H). +Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type + := match ls with + | nil => P nil + | x::xs => (P (x::xs) * Forall_tails P xs)%type + end. + +Record string_like (CharType : Type) := + { + String :> Type; + Singleton : CharType -> String where "[ x ]" := (Singleton x); + Empty : String; + Concat : String -> String -> String where "x ++ y" := (Concat x y); + bool_eq : String -> String -> bool; + bool_eq_correct : forall x y : String, bool_eq x y = true <-> x = y; + Length : String -> nat; + Associativity : forall x y z, (x ++ y) ++ z = x ++ (y ++ z); + LeftId : forall x, Empty ++ x = x; + RightId : forall x, x ++ Empty = x; + Singleton_Length : forall x, Length (Singleton x) = 1; + Length_correct : forall s1 s2, Length s1 + Length s2 = Length (s1 ++ s2); + Length_Empty : Length Empty = 0; + Empty_Length : forall s1, Length s1 = 0 -> s1 = Empty; + Not_Singleton_Empty : forall x, Singleton x <> Empty; + SplitAt : nat -> String -> String * String; + SplitAt_correct : forall n s, fst (SplitAt n s) ++ snd (SplitAt n s) = s; + SplitAt_concat_correct : forall s1 s2, SplitAt (Length s1) (s1 ++ s2) = (s1, s2); + SplitAtLength_correct : forall n s, Length (fst (SplitAt n s)) = min (Length s) n + }. + +Delimit Scope string_like_scope with string_like. +Bind Scope string_like_scope with String. +Arguments Length {_%type_scope _} _%string_like. +Notation "[[ x ]]" := (@Singleton _ _ x) : string_like_scope. +Infix "++" := (@Concat _ _) : string_like_scope. +Infix "=s" := (@bool_eq _ _) (at level 70, right associativity) : string_like_scope. + +Definition str_le {CharType} {String : string_like CharType} (s1 s2 : String) + := Length s1 < Length s2 \/ s1 = s2. +Infix "≤s" := str_le (at level 70, right associativity). + +Record StringWithSplitState {CharType} (String : string_like CharType) (split_stateT : String -> Type) := + { string_val :> String; + state_val : split_stateT string_val }. + +Module Export ContextFreeGrammar. + Require Import Coq.Strings.String. + + Section cfg. + Variable CharType : Type. + + Section definitions. + + Inductive item := + | Terminal (_ : CharType) + | NonTerminal (_ : string). + + Definition production := list item. + Definition productions := list production. + + Record grammar := + { + Start_symbol :> string; + Lookup :> string -> productions; + Start_productions :> productions := Lookup Start_symbol; + Valid_nonterminals : list string; + Valid_productions : list productions := map Lookup Valid_nonterminals + }. + End definitions. + + End cfg. + +End ContextFreeGrammar. +Module Export BaseTypes. + Import Coq.Strings.String. + + Local Open Scope string_like_scope. + + Inductive any_grammar CharType := + | include_item (_ : item CharType) + | include_production (_ : production CharType) + | include_productions (_ : productions CharType) + | include_nonterminal (_ : string). + Global Coercion include_item : item >-> any_grammar. + Global Coercion include_production : production >-> any_grammar. + + Section recursive_descent_parser. + Context {CharType : Type} + {String : string_like CharType} + {G : grammar CharType}. + + Class parser_computational_predataT := + { nonterminals_listT : Type; + initial_nonterminals_data : nonterminals_listT; + is_valid_nonterminal : nonterminals_listT -> string -> bool; + remove_nonterminal : nonterminals_listT -> string -> nonterminals_listT; + nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop; + remove_nonterminal_dec : forall ls nonterminal, + is_valid_nonterminal ls nonterminal = true + -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; + ntl_wf : well_founded nonterminals_listT_R }. + + Class parser_computational_types_dataT := + { predata :> parser_computational_predataT; + split_stateT : String -> nonterminals_listT -> any_grammar CharType -> String -> Type }. + + Class parser_computational_dataT' `{parser_computational_types_dataT} := + { split_string_for_production + : forall (str0 : String) (valid : nonterminals_listT) (it : item CharType) (its : production CharType) (str : StringWithSplitState String (split_stateT str0 valid (it::its : production CharType))), + list (StringWithSplitState String (split_stateT str0 valid it) + * StringWithSplitState String (split_stateT str0 valid its)); + split_string_for_production_correct + : forall str0 valid it its str, + let P f := List.Forall f (@split_string_for_production str0 valid it its str) in + P (fun s1s2 => (fst s1s2 ++ snd s1s2 =s str) = true) }. + End recursive_descent_parser. + +End BaseTypes. +Import Coq.Strings.String. + +Section cfg. + Context CharType (String : string_like CharType) (G : grammar CharType). + Context (names_listT : Type) + (initial_names_data : names_listT) + (is_valid_name : names_listT -> string -> bool) + (remove_name : names_listT -> string -> names_listT) + (names_listT_R : names_listT -> names_listT -> Prop) + (remove_name_dec : forall ls name, + is_valid_name ls name = true + -> names_listT_R (remove_name ls name) ls) + (remove_name_1 + : forall ls ps ps', + is_valid_name (remove_name ls ps) ps' = true + -> is_valid_name ls ps' = true) + (remove_name_2 + : forall ls ps ps', + is_valid_name (remove_name ls ps) ps' = false + <-> is_valid_name ls ps' = false \/ ps = ps') + (ntl_wf : well_founded names_listT_R). + + Inductive minimal_parse_of + : forall (str0 : String) (valid : names_listT) + (str : String), + productions CharType -> Type := + | MinParseHead : forall str0 valid str pat pats, + @minimal_parse_of_production str0 valid str pat + -> @minimal_parse_of str0 valid str (pat::pats) + | MinParseTail : forall str0 valid str pat pats, + @minimal_parse_of str0 valid str pats + -> @minimal_parse_of str0 valid str (pat::pats) + with minimal_parse_of_production + : forall (str0 : String) (valid : names_listT) + (str : String), + production CharType -> Type := + | MinParseProductionNil : forall str0 valid, + @minimal_parse_of_production str0 valid (Empty _) nil + | MinParseProductionCons : forall str0 valid str strs pat pats, + str ++ strs ≤s str0 + -> @minimal_parse_of_item str0 valid str pat + -> @minimal_parse_of_production str0 valid strs pats + -> @minimal_parse_of_production str0 valid (str ++ strs) (pat::pats) + with minimal_parse_of_item + : forall (str0 : String) (valid : names_listT) + (str : String), + item CharType -> Type := + | MinParseTerminal : forall str0 valid x, + @minimal_parse_of_item str0 valid [[ x ]]%string_like (Terminal x) + | MinParseNonTerminal + : forall str0 valid str name, + @minimal_parse_of_name str0 valid str name + -> @minimal_parse_of_item str0 valid str (NonTerminal CharType name) + with minimal_parse_of_name + : forall (str0 : String) (valid : names_listT) + (str : String), + string -> Type := + | MinParseNonTerminalStrLt + : forall str0 valid name str, + Length str < Length str0 + -> is_valid_name initial_names_data name = true + -> @minimal_parse_of str initial_names_data str (Lookup G name) + -> @minimal_parse_of_name str0 valid str name + | MinParseNonTerminalStrEq + : forall str valid name, + is_valid_name initial_names_data name = true + -> is_valid_name valid name = true + -> @minimal_parse_of str (remove_name valid name) str (Lookup G name) + -> @minimal_parse_of_name str valid str name. +End cfg. + +Local Coercion is_true : bool >-> Sortclass. + +Local Open Scope string_like_scope. + +Section general. + Context {CharType} {String : string_like CharType} {G : grammar CharType}. + + Class boolean_parser_dataT := + { predata :> parser_computational_predataT; + split_stateT : String -> Type; + data' :> _ := {| BaseTypes.predata := predata ; BaseTypes.split_stateT := fun _ _ _ => split_stateT |}; + split_string_for_production + : forall it its, + StringWithSplitState String split_stateT + -> list (StringWithSplitState String split_stateT * StringWithSplitState String split_stateT); + split_string_for_production_correct + : forall it its (str : StringWithSplitState String split_stateT), + let P f := List.Forall f (split_string_for_production it its str) in + P (fun s1s2 => + (fst s1s2 ++ snd s1s2 =s str) = true); + premethods :> parser_computational_dataT' + := @Build_parser_computational_dataT' + _ String data' + (fun _ _ => split_string_for_production) + (fun _ _ => split_string_for_production_correct) }. + + Definition split_list_completeT `{data : boolean_parser_dataT} + {str0 valid} + (str : StringWithSplitState String split_stateT) (pf : str ≤s str0) + (split_list : list (StringWithSplitState String split_stateT * StringWithSplitState String split_stateT)) + (it : item CharType) (its : production CharType) + := ({ s1s2 : String * String + & (fst s1s2 ++ snd s1s2 =s str) + * (minimal_parse_of_item _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (fst s1s2) it) + * (minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (snd s1s2) its) }%type) + -> ({ s1s2 : StringWithSplitState String split_stateT * StringWithSplitState String split_stateT + & (In s1s2 split_list) + * (minimal_parse_of_item _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (fst s1s2) it) + * (minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (snd s1s2) its) }%type). +End general. + +Section recursive_descent_parser. + Context {CharType} + {String : string_like CharType} + {G : grammar CharType}. + Context `{data : @boolean_parser_dataT _ String}. + + Section bool. + Section parts. + Definition parse_item + (str_matches_nonterminal : string -> bool) + (str : StringWithSplitState String split_stateT) + (it : item CharType) + : bool + := match it with + | Terminal ch => [[ ch ]] =s str + | NonTerminal nt => str_matches_nonterminal nt + end. + + Section production. + Context {str0} + (parse_nonterminal + : forall (str : StringWithSplitState String split_stateT), + str ≤s str0 + -> string + -> bool). + + Fixpoint parse_production + (str : StringWithSplitState String split_stateT) + (pf : str ≤s str0) + (prod : production CharType) + : bool. + Proof. + refine + match prod with + | nil => + + str =s Empty _ + | it::its + => let parse_production' := fun str pf => parse_production str pf its in + fold_right + orb + false + (let mapF f := map f (combine_sig (split_string_for_production_correct it its str)) in + mapF (fun s1s2p => + (parse_item + (parse_nonterminal (fst (proj1_sig s1s2p)) _) + (fst (proj1_sig s1s2p)) + it) + && parse_production' (snd (proj1_sig s1s2p)) _)%bool) + end; + revert pf; clear; intros; admit. + Defined. + End production. + + End parts. + End bool. +End recursive_descent_parser. + +Section sound. + Context CharType (String : string_like CharType) (G : grammar CharType). + Context `{data : @boolean_parser_dataT CharType String}. + + Section production. + Context (str0 : String) + (parse_nonterminal : forall (str : StringWithSplitState String split_stateT), + str ≤s str0 + -> string + -> bool). + + Definition parse_nonterminal_completeT P + := forall valid (str : StringWithSplitState String split_stateT) pf nonterminal (H_sub : P str0 valid nonterminal), + minimal_parse_of_name _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str nonterminal + -> @parse_nonterminal str pf nonterminal = true. + + Lemma parse_production_complete + valid Pv + (parse_nonterminal_complete : parse_nonterminal_completeT Pv) + (Hinit : forall str (pf : str ≤s str0) nonterminal, + minimal_parse_of_name String G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str nonterminal + -> Pv str0 valid nonterminal) + (str : StringWithSplitState String split_stateT) (pf : str ≤s str0) + (prod : production CharType) + (split_string_for_production_complete' + : forall str0 valid str pf, + Forall_tails + (fun prod' => + match prod' return Type with + | nil => True + | it::its => split_list_completeT (G := G) (valid := valid) (str0 := str0) str pf (split_string_for_production it its str) it its + end) + prod) + : minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str prod + -> parse_production parse_nonterminal str pf prod = true. + admit. + Defined. + End production. + Context (str0 : String) + (parse_nonterminal : forall (str : StringWithSplitState String split_stateT), + str ≤s str0 + -> string + -> bool). + + Goal forall (a : production CharType), + (forall (str1 : String) (valid : nonterminals_listT) + (str : StringWithSplitState String split_stateT) + (pf : str ≤s str1), + Forall_tails + (fun prod' : list (item CharType) => + match prod' with + | [] => True + | it :: its => + split_list_completeT (G := G) (valid := valid) str pf + (split_string_for_production it its str) it its + end) a) -> + forall (str : String) (pf : str ≤s str0) (st : split_stateT str), + parse_production parse_nonterminal + {| string_val := str; state_val := st |} pf a = true. + Proof. + intros a X **. + eapply parse_production_complete. + Focus 3. + exact X. + Undo. + assumption. + Undo. + eassumption. (* no applicable tactic *) diff --git a/test-suite/bugs/closed/bug_4161.v b/test-suite/bugs/closed/bug_4161.v new file mode 100644 index 0000000000..d2003ab1f0 --- /dev/null +++ b/test-suite/bugs/closed/bug_4161.v @@ -0,0 +1,27 @@ + + (* Inductive t : Type -> Type := *) + (* | Just : forall (A : Type), t A -> t A. *) + + (* Fixpoint test {A : Type} (x : t A) : t (A + unit) := *) + (* match x in t A return t (A + unit) with *) + (* | Just T x => @test T x *) + (* end. *) + + + Definition Type1 := Type. +Definition Type2 := Type. +Definition cast (x:Type2) := x:Type1. +Axiom f: Type2 -> Prop. +Definition A := + let T := fun A:Type1 => _ in + fun A':Type2 => + eq_refl : T A' = f A' :> Prop. +(* Type2 <= Type1... f A -> Type1 <= Type2 *) + +Inductive t : Type -> Type := + | Just : forall (A : Type), t A -> t A. + +Fixpoint test {A : Type} (x : t A) : t (A + unit) := + match x in t A with + | Just B x => @test B x + end. diff --git a/test-suite/bugs/closed/bug_4165.v b/test-suite/bugs/closed/bug_4165.v new file mode 100644 index 0000000000..8e0a62d35c --- /dev/null +++ b/test-suite/bugs/closed/bug_4165.v @@ -0,0 +1,7 @@ +Lemma foo : True. +Proof. +pose (fun x : nat => (let H:=true in x)) as s. +match eval cbv delta [s] in s with +| context C[true] => + let C':=context C[false] in pose C' as s' +end. diff --git a/test-suite/bugs/closed/bug_4187.v b/test-suite/bugs/closed/bug_4187.v new file mode 100644 index 0000000000..b13ca36a37 --- /dev/null +++ b/test-suite/bugs/closed/bug_4187.v @@ -0,0 +1,709 @@ +(* Lifted from https://coq.inria.fr/bugs/show_bug.cgi?id=4187 *) +(* File reduced by coq-bug-finder from original input, then from 715 lines to 696 lines *) +(* coqc version 8.4pl5 (December 2014) compiled on Dec 28 2014 03:23:16 with OCaml 4.01.0 + coqtop version 8.4pl5 (December 2014) *) +Set Asymmetric Patterns. +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Import Coq.Lists.List. +Require Import Coq.Setoids.Setoid. +Require Import Coq.Numbers.Natural.Peano.NPeano. +Global Set Implicit Arguments. +Global Generalizable All Variables. +Coercion is_true : bool >-> Sortclass. +Coercion bool_of_sumbool {A B} (x : {A} + {B}) : bool := if x then true else false. +Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type + := match ls return Type with + | nil => True + | x::xs => (P x * ForallT P xs)%type + end. +Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type + := match ls with + | nil => P nil + | x::xs => (P (x::xs) * Forall_tails P xs)%type + end. + +Module Export ADTSynthesis_DOT_Common_DOT_Wf. +Module Export ADTSynthesis. +Module Export Common. +Module Export Wf. + +Section wf. + Section wf_prod. + Context A B (RA : relation A) (RB : relation B). +Definition prod_relation : relation (A * B). +exact (fun ab a'b' => + RA (fst ab) (fst a'b') \/ (fst a'b' = fst ab /\ RB (snd ab) (snd a'b'))). +Defined. + + Fixpoint well_founded_prod_relation_helper + a b + (wf_A : Acc RA a) (wf_B : well_founded RB) {struct wf_A} + : Acc prod_relation (a, b) + := match wf_A with + | Acc_intro fa => (fix wf_B_rec b' (wf_B' : Acc RB b') : Acc prod_relation (a, b') + := Acc_intro + _ + (fun ab => + match ab as ab return prod_relation ab (a, b') -> Acc prod_relation ab with + | (a'', b'') => + fun pf => + match pf with + | or_introl pf' + => @well_founded_prod_relation_helper + _ _ + (fa _ pf') + wf_B + | or_intror (conj pfa pfb) + => match wf_B' with + | Acc_intro fb + => eq_rect + _ + (fun a'' => Acc prod_relation (a'', b'')) + (wf_B_rec _ (fb _ pfb)) + _ + pfa + end + end + end) + ) b (wf_B b) + end. + + Definition well_founded_prod_relation : well_founded RA -> well_founded RB -> well_founded prod_relation. + Proof. + intros wf_A wf_B [a b]; hnf in *. + apply well_founded_prod_relation_helper; auto. + Defined. + End wf_prod. + + Section wf_projT1. + Context A (B : A -> Type) (R : relation A). +Definition projT1_relation : relation (sigT B). +exact (fun ab a'b' => + R (projT1 ab) (projT1 a'b')). +Defined. + + Definition well_founded_projT1_relation : well_founded R -> well_founded projT1_relation. + Proof. + intros wf [a b]; hnf in *. + induction (wf a) as [a H IH]. + constructor. + intros y r. + specialize (IH _ r (projT2 y)). + destruct y. + exact IH. + Defined. + End wf_projT1. +End wf. + +Section Fix3. + Context A (B : A -> Type) (C : forall a, B a -> Type) (D : forall a b, C a b -> Type) + (R : A -> A -> Prop) (Rwf : well_founded R) + (P : forall a b c, D a b c -> Type) + (F : forall x : A, (forall y : A, R y x -> forall b c d, P y b c d) -> forall b c d, P x b c d). +Definition Fix3 a b c d : @P a b c d. +exact (@Fix { a : A & { b : B a & { c : C b & D c } } } + (fun x y => R (projT1 x) (projT1 y)) + (well_founded_projT1_relation Rwf) + (fun abcd => P (projT2 (projT2 (projT2 abcd)))) + (fun x f => @F (projT1 x) (fun y r b c d => f (existT _ y (existT _ b (existT _ c d))) r) _ _ _) + (existT _ a (existT _ b (existT _ c d)))). +Defined. +End Fix3. + +End Wf. + +End Common. + +End ADTSynthesis. + +End ADTSynthesis_DOT_Common_DOT_Wf. + +Module Export ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core. +Module Export ADTSynthesis. +Module Export Parsers. +Module Export StringLike. +Module Export Core. +Import Coq.Setoids.Setoid. +Import Coq.Classes.Morphisms. + + + +Module Export StringLike. + Class StringLike {Char : Type} := + { + String :> Type; + is_char : String -> Char -> bool; + length : String -> nat; + take : nat -> String -> String; + drop : nat -> String -> String; + bool_eq : String -> String -> bool; + beq : relation String := fun x y => bool_eq x y + }. + + Arguments StringLike : clear implicits. + Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope. + Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope. + Local Open Scope string_like_scope. + + Definition str_le `{StringLike Char} (s1 s2 : String) + := length s1 < length s2 \/ s1 =s s2. + Infix "≤s" := str_le (at level 70, right associativity). + + Class StringLikeProperties (Char : Type) `{StringLike Char} := + { + singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch'; + length_singleton : forall s ch, s ~= [ ch ] -> length s = 1; + bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s'; + is_char_Proper :> Proper (beq ==> eq ==> eq) is_char; + length_Proper :> Proper (beq ==> eq) length; + take_Proper :> Proper (eq ==> beq ==> beq) take; + drop_Proper :> Proper (eq ==> beq ==> beq) drop; + bool_eq_Equivalence :> Equivalence beq; + bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str'; + take_short_length : forall str n, n <= length str -> length (take n str) = n; + take_long : forall str n, length str <= n -> take n str =s str; + take_take : forall str n m, take n (take m str) =s take (min n m) str; + drop_length : forall str n, length (drop n str) = length str - n; + drop_0 : forall str, drop 0 str =s str; + drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str; + drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str); + take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str) + }. + + Arguments StringLikeProperties Char {_}. +End StringLike. + +End Core. + +End StringLike. + +End Parsers. + +End ADTSynthesis. + +End ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core. + +Module Export ADTSynthesis. +Module Export Parsers. +Module Export ContextFreeGrammar. +Require Import Coq.Strings.String. +Require Import Coq.Lists.List. +Export ADTSynthesis.Parsers.StringLike.Core. +Import ADTSynthesis.Common. + +Local Open Scope string_like_scope. + +Section cfg. + Context {Char : Type}. + + Section definitions. + + Inductive item := + | Terminal (_ : Char) + | NonTerminal (_ : string). + + Definition production := list item. + Definition productions := list production. + + Record grammar := + { + Start_symbol :> string; + Lookup :> string -> productions; + Start_productions :> productions := Lookup Start_symbol; + Valid_nonterminals : list string; + Valid_productions : list productions := map Lookup Valid_nonterminals + }. + End definitions. + + Section parse. + Context {HSL : StringLike Char}. + Variable G : grammar. + + Inductive parse_of (str : String) : productions -> Type := + | ParseHead : forall pat pats, parse_of_production str pat + -> parse_of str (pat::pats) + | ParseTail : forall pat pats, parse_of str pats + -> parse_of str (pat::pats) + with parse_of_production (str : String) : production -> Type := + | ParseProductionNil : length str = 0 -> parse_of_production str nil + | ParseProductionCons : forall n pat pats, + parse_of_item (take n str) pat + -> parse_of_production (drop n str) pats + -> parse_of_production str (pat::pats) + with parse_of_item (str : String) : item -> Type := + | ParseTerminal : forall ch, str ~= [ ch ] -> parse_of_item str (Terminal ch) + | ParseNonTerminal : forall nt, parse_of str (Lookup G nt) + -> parse_of_item str (NonTerminal nt). + End parse. +End cfg. + +Arguments item _ : clear implicits. +Arguments production _ : clear implicits. +Arguments productions _ : clear implicits. +Arguments grammar _ : clear implicits. + +End ContextFreeGrammar. + +Module Export BaseTypes. + +Section recursive_descent_parser. + + Class parser_computational_predataT := + { nonterminals_listT : Type; + initial_nonterminals_data : nonterminals_listT; + is_valid_nonterminal : nonterminals_listT -> String.string -> bool; + remove_nonterminal : nonterminals_listT -> String.string -> nonterminals_listT; + nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop; + remove_nonterminal_dec : forall ls nonterminal, + is_valid_nonterminal ls nonterminal + -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; + ntl_wf : well_founded nonterminals_listT_R }. + + Class parser_removal_dataT' `{predata : parser_computational_predataT} := + { remove_nonterminal_1 + : forall ls ps ps', + is_valid_nonterminal (remove_nonterminal ls ps) ps' + -> is_valid_nonterminal ls ps'; + remove_nonterminal_2 + : forall ls ps ps', + is_valid_nonterminal (remove_nonterminal ls ps) ps' = false + <-> is_valid_nonterminal ls ps' = false \/ ps = ps' }. +End recursive_descent_parser. + +End BaseTypes. +Import Coq.Lists.List. +Import ADTSynthesis.Parsers.ContextFreeGrammar. + +Local Open Scope string_like_scope. + +Section cfg. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + Context {predata : @parser_computational_predataT} + {rdata' : @parser_removal_dataT' predata}. + + Inductive minimal_parse_of + : forall (str0 : String) (valid : nonterminals_listT) + (str : String), + productions Char -> Type := + | MinParseHead : forall str0 valid str pat pats, + @minimal_parse_of_production str0 valid str pat + -> @minimal_parse_of str0 valid str (pat::pats) + | MinParseTail : forall str0 valid str pat pats, + @minimal_parse_of str0 valid str pats + -> @minimal_parse_of str0 valid str (pat::pats) + with minimal_parse_of_production + : forall (str0 : String) (valid : nonterminals_listT) + (str : String), + production Char -> Type := + | MinParseProductionNil : forall str0 valid str, + length str = 0 + -> @minimal_parse_of_production str0 valid str nil + | MinParseProductionCons : forall str0 valid str n pat pats, + str ≤s str0 + -> @minimal_parse_of_item str0 valid (take n str) pat + -> @minimal_parse_of_production str0 valid (drop n str) pats + -> @minimal_parse_of_production str0 valid str (pat::pats) + with minimal_parse_of_item + : forall (str0 : String) (valid : nonterminals_listT) + (str : String), + item Char -> Type := + | MinParseTerminal : forall str0 valid str ch, + str ~= [ ch ] + -> @minimal_parse_of_item str0 valid str (Terminal ch) + | MinParseNonTerminal + : forall str0 valid str (nt : String.string), + @minimal_parse_of_nonterminal str0 valid str nt + -> @minimal_parse_of_item str0 valid str (NonTerminal nt) + with minimal_parse_of_nonterminal + : forall (str0 : String) (valid : nonterminals_listT) + (str : String), + String.string -> Type := + | MinParseNonTerminalStrLt + : forall str0 valid (nt : String.string) str, + length str < length str0 + -> is_valid_nonterminal initial_nonterminals_data nt + -> @minimal_parse_of str initial_nonterminals_data str (Lookup G nt) + -> @minimal_parse_of_nonterminal str0 valid str nt + | MinParseNonTerminalStrEq + : forall str0 str valid nonterminal, + str =s str0 + -> is_valid_nonterminal initial_nonterminals_data nonterminal + -> is_valid_nonterminal valid nonterminal + -> @minimal_parse_of str0 (remove_nonterminal valid nonterminal) str (Lookup G nonterminal) + -> @minimal_parse_of_nonterminal str0 valid str nonterminal. +End cfg. +Import ADTSynthesis.Common. + +Section general. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + + Class boolean_parser_dataT := + { predata :> parser_computational_predataT; + split_string_for_production + : item Char -> production Char -> String -> list nat }. + + Global Coercion predata : boolean_parser_dataT >-> parser_computational_predataT. + + Definition split_list_completeT `{data : @parser_computational_predataT} + {str0 valid} + (it : item Char) (its : production Char) + (str : String) + (pf : str ≤s str0) + (split_list : list nat) + + := ({ n : nat + & (minimal_parse_of_item (G := G) (predata := data) str0 valid (take n str) it) + * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type) + -> ({ n : nat + & (In n split_list) + * (minimal_parse_of_item (G := G) str0 valid (take n str) it) + * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type). + + Class boolean_parser_completeness_dataT' `{data : boolean_parser_dataT} := + { split_string_for_production_complete + : forall str0 valid str (pf : str ≤s str0) nt, + is_valid_nonterminal initial_nonterminals_data nt + -> ForallT + (Forall_tails + (fun prod + => match prod return Type with + | nil => True + | it::its + => @split_list_completeT data str0 valid it its str pf (split_string_for_production it its str) + end)) + (Lookup G nt) }. +End general. + +Module Export BooleanRecognizer. +Import Coq.Numbers.Natural.Peano.NPeano. +Import Coq.Arith.Compare_dec. +Import Coq.Arith.Wf_nat. + +Section recursive_descent_parser. + Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} {G : grammar Char}. + Context {data : @boolean_parser_dataT Char _}. + + Section bool. + Section parts. +Definition parse_item + (str_matches_nonterminal : String.string -> bool) + (str : String) + (it : item Char) + : bool. +Admitted. + + Section production. + Context {str0} + (parse_nonterminal + : forall (str : String), + str ≤s str0 + -> String.string + -> bool). + + Fixpoint parse_production + (str : String) + (pf : str ≤s str0) + (prod : production Char) + : bool. + Proof. + refine + match prod with + | nil => + + Nat.eq_dec (length str) 0 + | it::its + => let parse_production' := fun str pf => parse_production str pf its in + fold_right + orb + false + (map (fun n => + (parse_item + (parse_nonterminal (str := take n str) _) + (take n str) + it) + && parse_production' (drop n str) _)%bool + (split_string_for_production it its str)) + end; + revert pf; clear -HSLP; intros; admit. + Defined. + End production. + + Section productions. + Context {str0} + (parse_nonterminal + : forall (str : String) + (pf : str ≤s str0), + String.string -> bool). +Definition parse_productions + (str : String) + (pf : str ≤s str0) + (prods : productions Char) + : bool. +exact (fold_right orb + false + (map (parse_production parse_nonterminal pf) + prods)). +Defined. + End productions. + + Section nonterminals. + Section step. + Context {str0 valid} + (parse_nonterminal + : forall (p : String * nonterminals_listT), + prod_relation (ltof _ length) nonterminals_listT_R p (str0, valid) + -> forall str : String, + str ≤s fst p -> String.string -> bool). + + Definition parse_nonterminal_step + (str : String) + (pf : str ≤s str0) + (nt : String.string) + : bool. + Proof. + refine + (if lt_dec (length str) (length str0) + then + parse_productions + (@parse_nonterminal + (str : String, initial_nonterminals_data) + (or_introl _)) + (or_intror (reflexivity _)) + (Lookup G nt) + else + if Sumbool.sumbool_of_bool (is_valid_nonterminal valid nt) + then + parse_productions + (@parse_nonterminal + (str0 : String, remove_nonterminal valid nt) + (or_intror (conj eq_refl (remove_nonterminal_dec _ nt _)))) + (str := str) + _ + (Lookup G nt) + else + false); + assumption. + Defined. + End step. + + Section wf. +Definition parse_nonterminal_or_abort + : forall (p : String * nonterminals_listT) + (str : String), + str ≤s fst p + -> String.string + -> bool. +exact (Fix3 + _ _ _ + (well_founded_prod_relation + (well_founded_ltof _ length) + ntl_wf) + _ + (fun sl => @parse_nonterminal_step (fst sl) (snd sl))). +Defined. +Definition parse_nonterminal + (str : String) + (nt : String.string) + : bool. +exact (@parse_nonterminal_or_abort + (str : String, initial_nonterminals_data) str + (or_intror (reflexivity _)) nt). +Defined. + End wf. + End nonterminals. + End parts. + End bool. +End recursive_descent_parser. + +Section cfg. + Context {Char} {HSL : StringLike Char} {HSLP : @StringLikeProperties Char HSL} (G : grammar Char). + + Section definitions. + Context (P : String -> String.string -> Type). + + Definition Forall_parse_of_item' + (Forall_parse_of : forall {str pats} (p : parse_of G str pats), Type) + {str it} (p : parse_of_item G str it) + := match p return Type with + | ParseTerminal ch pf => unit + | ParseNonTerminal nt p' + => (P str nt * Forall_parse_of p')%type + end. + + Fixpoint Forall_parse_of {str pats} (p : parse_of G str pats) + := match p with + | ParseHead pat pats p' + => Forall_parse_of_production p' + | ParseTail _ _ p' + => Forall_parse_of p' + end + with Forall_parse_of_production {str pat} (p : parse_of_production G str pat) + := match p return Type with + | ParseProductionNil pf => unit + | ParseProductionCons pat strs pats p' p'' + => (Forall_parse_of_item' (@Forall_parse_of) p' * Forall_parse_of_production p'')%type + end. + + Definition Forall_parse_of_item {str it} (p : parse_of_item G str it) + := @Forall_parse_of_item' (@Forall_parse_of) str it p. + End definitions. + + End cfg. + +Section recursive_descent_parser_list. + Context {Char} {HSL : StringLike Char} {HLSP : StringLikeProperties Char} {G : grammar Char}. +Definition rdp_list_nonterminals_listT : Type. +exact (list String.string). +Defined. +Definition rdp_list_is_valid_nonterminal : rdp_list_nonterminals_listT -> String.string -> bool. +admit. +Defined. +Definition rdp_list_remove_nonterminal : rdp_list_nonterminals_listT -> String.string -> rdp_list_nonterminals_listT. +admit. +Defined. +Definition rdp_list_nonterminals_listT_R : rdp_list_nonterminals_listT -> rdp_list_nonterminals_listT -> Prop. +exact (ltof _ (@List.length _)). +Defined. + Lemma rdp_list_remove_nonterminal_dec : forall ls prods, + @rdp_list_is_valid_nonterminal ls prods = true + -> @rdp_list_nonterminals_listT_R (@rdp_list_remove_nonterminal ls prods) ls. +admit. +Defined. + Lemma rdp_list_ntl_wf : well_founded rdp_list_nonterminals_listT_R. + Proof. + unfold rdp_list_nonterminals_listT_R. + intro. + apply well_founded_ltof. + Defined. + + Global Instance rdp_list_predata : parser_computational_predataT + := { nonterminals_listT := rdp_list_nonterminals_listT; + initial_nonterminals_data := Valid_nonterminals G; + is_valid_nonterminal := rdp_list_is_valid_nonterminal; + remove_nonterminal := rdp_list_remove_nonterminal; + nonterminals_listT_R := rdp_list_nonterminals_listT_R; + remove_nonterminal_dec := rdp_list_remove_nonterminal_dec; + ntl_wf := rdp_list_ntl_wf }. +End recursive_descent_parser_list. + +Section sound. + Section general. + Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char). + Context {data : @boolean_parser_dataT Char _} + {cdata : @boolean_parser_completeness_dataT' Char _ G data} + {rdata : @parser_removal_dataT' predata}. + + Section parts. + + Section nonterminals. + Section wf. + + Lemma parse_nonterminal_sound + (str : String) (nonterminal : String.string) + : parse_nonterminal (G := G) str nonterminal + = true + -> parse_of_item G str (NonTerminal nonterminal). +admit. +Defined. + End wf. + End nonterminals. + End parts. + End general. +End sound. + +Import Coq.Strings.String. +Import ADTSynthesis.Parsers.ContextFreeGrammar. + +Fixpoint list_to_productions {T} (default : T) (ls : list (string * T)) : string -> T + := match ls with + | nil => fun _ => default + | (str, t)::ls' => fun s => if string_dec str s + then t + else list_to_productions default ls' s + end. + +Fixpoint list_to_grammar {T} (default : productions T) (ls : list (string * productions T)) : grammar T + := {| Start_symbol := hd ""%string (map (@fst _ _) ls); + Lookup := list_to_productions default ls; + Valid_nonterminals := map (@fst _ _) ls |}. + +Section interface. + Context {Char} (G : grammar Char). +Definition production_is_reachable (p : production Char) : Prop. +admit. +Defined. +Definition split_list_is_complete `{HSL : StringLike Char} (str : String) (it : item Char) (its : production Char) + (splits : list nat) + : Prop. +exact (forall n, + n <= length str + -> parse_of_item G (take n str) it + -> parse_of_production G (drop n str) its + -> production_is_reachable (it::its) + -> List.In n splits). +Defined. + + Record Splitter := + { + string_type :> StringLike Char; + splits_for : String -> item Char -> production Char -> list nat; + + string_type_properties :> StringLikeProperties Char; + splits_for_complete : forall str it its, + split_list_is_complete str it its (splits_for str it its) + + }. + Global Existing Instance string_type_properties. + + Record Parser (HSL : StringLike Char) := + { + has_parse : @String Char HSL -> bool; + + has_parse_sound : forall str, + has_parse str = true + -> parse_of_item G str (NonTerminal (Start_symbol G)); + + has_parse_complete : forall str (p : parse_of_item G str (NonTerminal (Start_symbol G))), + Forall_parse_of_item + (fun _ nt => List.In nt (Valid_nonterminals G)) + p + -> has_parse str = true + }. +End interface. + +Module Export ParserImplementation. + +Section implementation. + Context {Char} {G : grammar Char}. + Context (splitter : Splitter G). + + Local Instance parser_data : @boolean_parser_dataT Char _ := + { predata := rdp_list_predata (G := G); + split_string_for_production it its str + := splits_for splitter str it its }. + + Program Definition parser : Parser G splitter + := {| has_parse str := parse_nonterminal (G := G) (data := parser_data) str (Start_symbol G); + has_parse_sound str Hparse := parse_nonterminal_sound G _ _ Hparse; + has_parse_complete str p Hp := _ |}. + Next Obligation. +admit. +Defined. +End implementation. + +End ParserImplementation. + +Section implementation. + Context {Char} {ls : list (String.string * productions Char)}. + Local Notation G := (list_to_grammar (nil::nil) ls) (only parsing). + Context (splitter : Splitter G). + + Local Instance parser_data : @boolean_parser_dataT Char _ := parser_data splitter. + + Goal forall str : @String Char splitter, + let G' := + @BooleanRecognizer.parse_nonterminal Char splitter splitter G parser_data str G = true in + G'. + intros str G'. + Timeout 1 assert (pf' : G' -> Prop) by abstract admit. diff --git a/test-suite/bugs/closed/bug_4190.v b/test-suite/bugs/closed/bug_4190.v new file mode 100644 index 0000000000..2843488ba0 --- /dev/null +++ b/test-suite/bugs/closed/bug_4190.v @@ -0,0 +1,15 @@ +Module Type A . + Tactic Notation "bar" := idtac "ITSME". +End A. + +Module Type B. + Tactic Notation "foo" := fail "NOTME". +End B. + +Module Type C := A <+ B. + +Module Type F (Import M : C). + +Lemma foo : True. +Proof. +bar. diff --git a/test-suite/bugs/closed/bug_4191.v b/test-suite/bugs/closed/bug_4191.v new file mode 100644 index 0000000000..d9268dbe2f --- /dev/null +++ b/test-suite/bugs/closed/bug_4191.v @@ -0,0 +1,5 @@ +(* Test maximal implicit arguments in the presence of let-ins *) +Definition foo (x := 1) {y : nat} (H : y = y) : True := I. +Definition bar {y : nat} (x := 1) (H : y = y) : True := I. +Check bar (eq_refl 1). +Check foo (eq_refl 1). diff --git a/test-suite/bugs/closed/bug_4193.v b/test-suite/bugs/closed/bug_4193.v new file mode 100644 index 0000000000..885d04a927 --- /dev/null +++ b/test-suite/bugs/closed/bug_4193.v @@ -0,0 +1,7 @@ +Module Type E. +End E. + +Module Type A (M : E). +End A. + +Fail Module Type F (Import X : A). diff --git a/test-suite/bugs/closed/bug_4198.v b/test-suite/bugs/closed/bug_4198.v new file mode 100644 index 0000000000..53381b10a5 --- /dev/null +++ b/test-suite/bugs/closed/bug_4198.v @@ -0,0 +1,39 @@ +(* Check that the subterms of the predicate of a match are taken into account *) + +Require Import List. +Open Scope list_scope. +Goal forall A (x x' : A) (xs xs' : list A) (H : x::xs = x'::xs'), + let k := + (match H in (_ = y) return x = hd x y with + | eq_refl => eq_refl + end : x = x') + in k = k. + simpl. + intros. + match goal with + | [ |- context G[@hd] ] => idtac + end. +Abort. + +(* This second example comes from CFGV where inspecting subterms of a + match is expecting to inspect first the term to match (even though + it would certainly be better to provide a "match x with _ end" + construct for generically matching a "match") *) + +Ltac find_head_of_head_match T := + match T with context [?E] => + match T with + | E => fail 1 + | _ => constr:(E) + end + end. + +Ltac mydestruct := + match goal with + | |- ?T1 = _ => let E := find_head_of_head_match T1 in destruct E + end. + +Goal forall x, match x with 0 => 0 | _ => 0 end = 0. +intros. +mydestruct. +Abort. diff --git a/test-suite/bugs/closed/bug_4202.v b/test-suite/bugs/closed/bug_4202.v new file mode 100644 index 0000000000..522a3604a3 --- /dev/null +++ b/test-suite/bugs/closed/bug_4202.v @@ -0,0 +1,10 @@ +Parameter g : nat -> Prop. +Axiom a : forall n, g (S n). +Lemma foo (H : True) : exists n, g n /\ g n. +eexists. +clear H. +split. +simple apply a. +(* goal is "g (S ?Goal0@ {H:=H})" while H has long ceased to exist *) +simpl. +Abort. diff --git a/test-suite/bugs/closed/bug_4203.v b/test-suite/bugs/closed/bug_4203.v new file mode 100644 index 0000000000..eb6867a033 --- /dev/null +++ b/test-suite/bugs/closed/bug_4203.v @@ -0,0 +1,19 @@ +Set Primitive Projections. + +Record ops {T:Type} := { is_ok : T -> Prop; constant : T }. +Arguments ops : clear implicits. + +Record ops_ok {T} (Ops:ops T) := { constant_ok : is_ok Ops (constant Ops) }. + +Definition nat_ops : ops nat := {| is_ok := fun n => n = 1; constant := 1 |}. +Definition nat_ops_ok : ops_ok nat_ops. +Proof. + split. cbn. apply eq_refl. +Qed. + +Definition t := Eval lazy in constant_ok nat_ops nat_ops_ok. +Definition t' := Eval vm_compute in constant_ok nat_ops nat_ops_ok. +Definition t'' := Eval native_compute in constant_ok nat_ops nat_ops_ok. + +Check (eq_refl t : t = t'). +Check (eq_refl t : t = t''). diff --git a/test-suite/bugs/closed/bug_4205.v b/test-suite/bugs/closed/bug_4205.v new file mode 100644 index 0000000000..c40dfcc1f3 --- /dev/null +++ b/test-suite/bugs/closed/bug_4205.v @@ -0,0 +1,8 @@ +(* Testing a regression from 8.5beta1 to 8.5beta2 in evar-evar tactic unification problems *) + + +Inductive test : nat -> nat -> nat -> nat -> Prop := + | test1 : forall m n, test m n m n. + +Goal test 1 2 3 4. +erewrite f_equal2 with (f := fun k l => test _ _ k l). diff --git a/test-suite/bugs/closed/bug_4214.v b/test-suite/bugs/closed/bug_4214.v new file mode 100644 index 0000000000..2e620fce2a --- /dev/null +++ b/test-suite/bugs/closed/bug_4214.v @@ -0,0 +1,6 @@ +(* Check that subst uses all equations around *) +Goal forall A (a b c : A), b = a -> b = c -> a = c. +intros. +subst. +reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_4216.v b/test-suite/bugs/closed/bug_4216.v new file mode 100644 index 0000000000..60b1311ace --- /dev/null +++ b/test-suite/bugs/closed/bug_4216.v @@ -0,0 +1,19 @@ +Generalizable Variables T A. + +Inductive path `(a: A): A -> Type := idpath: path a a. + +Class TMonad (T: Type -> Type) := { + bind: forall {A B: Type}, (T A) -> (A -> T B) -> T B; + ret: forall {A: Type}, A -> T A; + ret_unit_left: forall {A B: Type} (k: A -> T B) (a: A), + path (bind (ret a) k) (k a) + }. + +Let T_fzip `{TMonad T} := fun (A B: Type) (f: T (A -> B)) (t: T A) + => bind t (fun a => bind f (fun g => ret (g a) )). +Let T_pure `{TMonad T} := @ret _ _. + +Let T_pure_id `{TMonad T} {A: Type} (t: A -> A) (x: T A): + path (T_fzip A A (T_pure (A -> A) t) x) x. + unfold T_fzip, T_pure. + Fail rewrite (ret_unit_left (fun g a => ret (g a)) (fun x => x)). diff --git a/test-suite/bugs/closed/bug_4217.v b/test-suite/bugs/closed/bug_4217.v new file mode 100644 index 0000000000..19973f30a7 --- /dev/null +++ b/test-suite/bugs/closed/bug_4217.v @@ -0,0 +1,6 @@ +(* Checking correct index of implicit by pos in fixpoints *) + +Fixpoint ith_default + {default_A : nat} + {As : list nat} + {struct As} : Set. diff --git a/test-suite/bugs/closed/bug_4221.v b/test-suite/bugs/closed/bug_4221.v new file mode 100644 index 0000000000..bc120fb1ff --- /dev/null +++ b/test-suite/bugs/closed/bug_4221.v @@ -0,0 +1,9 @@ +(* Some test checking that interpreting binder names using ltac + context does not accidentally break the bindings *) + +Goal (forall x : nat, x = 1 -> False) -> 1 = 1 -> False. + intros H0 x. + lazymatch goal with + | [ x : forall k : nat, _ |- _ ] + => specialize (fun H0 => x 1 H0) + end. diff --git a/test-suite/bugs/closed/bug_4232.v b/test-suite/bugs/closed/bug_4232.v new file mode 100644 index 0000000000..61e544a914 --- /dev/null +++ b/test-suite/bugs/closed/bug_4232.v @@ -0,0 +1,20 @@ +Require Import Setoid Morphisms Vector. + +Class Equiv A := equiv : A -> A -> Prop. +Class Setoid A `{Equiv A} := setoid_equiv:> Equivalence (equiv). + +Global Declare Instance vec_equiv {A} `{Equiv A} {n}: Equiv (Vector.t A n). +Global Declare Instance vec_setoid A `{Setoid A} n : Setoid (Vector.t A n). + +Global Declare Instance tl_proper1 {A} `{Equiv A} n: + Proper ((equiv) ==> (equiv)) + (@tl A n). + +Lemma test: + forall {A} `{Setoid A} n (xa ya: Vector.t A (S n)), + (equiv xa ya) -> equiv (tl xa) (tl ya). +Proof. + intros A R HA n xa ya Heq. + setoid_rewrite Heq. + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_4234.v b/test-suite/bugs/closed/bug_4234.v new file mode 100644 index 0000000000..348dd49d93 --- /dev/null +++ b/test-suite/bugs/closed/bug_4234.v @@ -0,0 +1,7 @@ +Definition UU := Type. + +Definition dirprodpair {X Y : UU} := existT (fun x : X => Y). + +Definition funtoprodtoprod {X Y Z : UU} : { a : X -> Y & X -> Z }. +Proof. + refine (dirprodpair _ (fun x => _)). diff --git a/test-suite/bugs/closed/bug_4240.v b/test-suite/bugs/closed/bug_4240.v new file mode 100644 index 0000000000..083c59fe68 --- /dev/null +++ b/test-suite/bugs/closed/bug_4240.v @@ -0,0 +1,12 @@ +(* Check that closure of filter did not restrict the former evar filter *) + +Lemma foo (new : nat) : False. +evar (H1: nat). +set (H3 := 0). +assert (H3' := id H3). +evar (H5: nat). +clear H3. +assert (H5 = new). +unfold H5. +unfold H1. +exact (eq_refl new). diff --git a/test-suite/bugs/closed/bug_4250.v b/test-suite/bugs/closed/bug_4250.v new file mode 100644 index 0000000000..f5d0d1a523 --- /dev/null +++ b/test-suite/bugs/closed/bug_4250.v @@ -0,0 +1,11 @@ +Require Import FunInd. +Require Vector. +Generalizable All Variables. + +Definition f `{n:nat , u:Vector.t A n} := n. + +Function f2 {A:Type} {n:nat} {v:Vector.t A n} : nat := n. + +(* fails with "The reference A was not found in the current environment." *) +Function f3 `{n:nat , u:Vector.t A n} := u. +Check R_f3_complete. diff --git a/test-suite/bugs/closed/bug_4251.v b/test-suite/bugs/closed/bug_4251.v new file mode 100644 index 0000000000..776851cebb --- /dev/null +++ b/test-suite/bugs/closed/bug_4251.v @@ -0,0 +1,17 @@ + +Inductive array : Type -> Type := +| carray : forall A, array A. + +Inductive Mtac : Type -> Prop := +| bind : forall {A B}, Mtac A -> (A -> Mtac B) -> Mtac B +| array_make : forall {A}, A -> Mtac (array A). + +Definition Ref := array. + +Definition ref : forall {A}, A -> Mtac (Ref A) := + fun A x=> array_make x. +Check array Type. +Check fun A : Type => Ref A. + +Definition abs_val (a : Type) := + bind (ref a) (fun r : array Type => array_make tt). diff --git a/test-suite/bugs/closed/bug_4254.v b/test-suite/bugs/closed/bug_4254.v new file mode 100644 index 0000000000..ef219973df --- /dev/null +++ b/test-suite/bugs/closed/bug_4254.v @@ -0,0 +1,13 @@ +Inductive foo (V:Type):Type := + | Foo : list (bar V) -> foo V +with bar (V:Type): Type := + | bar1: bar V + | bar2 : V -> bar V. + +Module WithPoly. +Polymorphic Inductive foo (V:Type):Type := + | Foo : list (bar V) -> foo V +with bar (V:Type): Type := + | bar1: bar V + | bar2 : V -> bar V. +End WithPoly. diff --git a/test-suite/bugs/closed/bug_4256.v b/test-suite/bugs/closed/bug_4256.v new file mode 100644 index 0000000000..3e5438cd46 --- /dev/null +++ b/test-suite/bugs/closed/bug_4256.v @@ -0,0 +1,43 @@ +(* Testing 8.5 regression with type classes not solving evars + redefined while trying to solve them with the type class mechanism *) + +Global Set Universe Polymorphism. +Monomorphic Universe i. +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. +Notation "-1" := (trunc_S minus_two) (at level 0). + +Class IsPointed (A : Type) := point : A. +Arguments point A {_}. + +Record pType := + { pointed_type : Type ; + ispointed_type : IsPointed pointed_type }. +Coercion pointed_type : pType >-> Sortclass. +Existing Instance ispointed_type. + +Private Inductive Trunc (n : trunc_index) (A :Type) : Type := + tr : A -> Trunc n A. +Arguments tr {n A} a. + + + +Record ooGroup := + { classifying_space : pType@{i} }. + +Definition group_loops (X : pType) +: ooGroup. +Proof. + (** This works: *) + pose (x0 := point X). + pose (H := existT (fun x:X => Trunc -1 (x = point X)) x0 (tr idpath)). + clear H x0. + (** But this doesn't: *) + pose (existT (fun x:X => Trunc -1 (x = point X)) (point X) (tr idpath)). diff --git a/test-suite/bugs/closed/bug_4272.v b/test-suite/bugs/closed/bug_4272.v new file mode 100644 index 0000000000..aeb4c9bb95 --- /dev/null +++ b/test-suite/bugs/closed/bug_4272.v @@ -0,0 +1,12 @@ +Set Implicit Arguments. + +Record foo := Foo { p1 : Type; p2 : p1 }. + +Variable x : foo. + +Let p := match x with @Foo a b => a end. + +Notation "@ 'id'" := 3 (at level 10). +Notation "@ 'sval'" := 3 (at level 10). + +Let q := match x with @Foo a b => a end. diff --git a/test-suite/bugs/closed/bug_4273.v b/test-suite/bugs/closed/bug_4273.v new file mode 100644 index 0000000000..5ff78b1ef2 --- /dev/null +++ b/test-suite/bugs/closed/bug_4273.v @@ -0,0 +1,9 @@ + + +Set Primitive Projections. +Record total2 (P : nat -> Prop) := tpair { pr1 : nat; pr2 : P pr1 }. +Theorem onefiber' (q : total2 (fun y => y = 0)) : True. +Proof. assert (foo:=pr2 _ q). simpl in foo. + destruct foo. (* Error: q is used in conclusion. *) exact I. Qed. + +Print onefiber'. diff --git a/test-suite/bugs/closed/bug_4276.v b/test-suite/bugs/closed/bug_4276.v new file mode 100644 index 0000000000..f0da3e490a --- /dev/null +++ b/test-suite/bugs/closed/bug_4276.v @@ -0,0 +1,11 @@ +Set Primitive Projections. + +Record box (T U : Type) (x := T) := wrap { unwrap : T }. +Definition mybox : box True False := wrap _ _ I. +Definition unwrap' := @unwrap. + +Definition bad' : True := mybox.(unwrap _ _). + +Fail Definition bad : False := unwrap _ _ mybox. + +(* Closed under the global context *) diff --git a/test-suite/bugs/closed/bug_4280.v b/test-suite/bugs/closed/bug_4280.v new file mode 100644 index 0000000000..fd7897509e --- /dev/null +++ b/test-suite/bugs/closed/bug_4280.v @@ -0,0 +1,24 @@ +Require Import ZArith. +Require Import Eqdep_dec. +Local Open Scope Z_scope. + +Definition t := { n: Z | n > 1 }. + +Program Definition two : t := 2. +Next Obligation. omega. Qed. + +Program Definition t_eq (x y: t) : {x=y} + {x<>y} := + if Z.eq_dec (proj1_sig x) (proj1_sig y) then left _ else right _. +Next Obligation. + destruct x as [x Px], y as [y Py]. simpl in H; subst y. + f_equal. apply UIP_dec. decide equality. +Qed. +Next Obligation. + congruence. +Qed. + +Definition t_list_eq: forall (x y: list t), {x=y} + {x<>y}. +Proof. decide equality. apply t_eq. Defined. + +Goal match t_list_eq (two::nil) (two::nil) with left _ => True | right _ => False end. +Proof. exact I. Qed. diff --git a/test-suite/bugs/closed/bug_4283.v b/test-suite/bugs/closed/bug_4283.v new file mode 100644 index 0000000000..2a8b517bd4 --- /dev/null +++ b/test-suite/bugs/closed/bug_4283.v @@ -0,0 +1,7 @@ +Require Import Hurkens. + +Polymorphic Record box (X : Type) (T := Type) : Type := wrap { unwrap : T }. + +Definition unwrap' := fun (X : Type) (b : box X) => let (unwrap) := b in unwrap. + +Fail Definition bad : False := TypeNeqSmallType.paradox (unwrap' Type (wrap _ Type)) eq_refl. diff --git a/test-suite/bugs/closed/bug_4284.v b/test-suite/bugs/closed/bug_4284.v new file mode 100644 index 0000000000..0fff3026ff --- /dev/null +++ b/test-suite/bugs/closed/bug_4284.v @@ -0,0 +1,6 @@ +Set Primitive Projections. +Record total2 { T: Type } ( P: T -> Type ) := tpair { pr1 : T; pr2 : P pr1 }. +Theorem onefiber' {X : Type} (P : X -> Type) (x : X) : True. +Proof. +set (Q1 := total2 (fun f => pr1 P f = x)). +set (f1:=fun q1 : Q1 => pr2 _ (pr1 _ q1)). diff --git a/test-suite/bugs/closed/bug_4287.v b/test-suite/bugs/closed/bug_4287.v new file mode 100644 index 0000000000..757b71b2dd --- /dev/null +++ b/test-suite/bugs/closed/bug_4287.v @@ -0,0 +1,123 @@ +Unset Strict Universe Declaration. + +Universe b. + +Universe c. + +Definition U : Type@{b} := Type@{c}. + +Module Type MT. + +Definition T := Prop. +End MT. + +Module M : MT. + Definition T := Type@{b}. + +Print Universes. +Fail End M. + +Set Universe Polymorphism. + +(* This is a modified version of Hurkens with all universes floating *) +Section Hurkens. + +Variable down : Type -> Type. +Variable up : Type -> Type. + +Hypothesis back : forall A, up (down A) -> A. + +Hypothesis forth : forall A, A -> up (down A). + +Hypothesis backforth : forall (A:Type) (P:A->Type) (a:A), + P (back A (forth A a)) -> P a. + +Hypothesis backforth_r : forall (A:Type) (P:A->Type) (a:A), + P a -> P (back A (forth A a)). + +(** Proof *) +Definition V : Type := forall A:Type, ((up A -> Type) -> up A -> Type) -> up A -> Type. +Definition U : Type := V -> Type. + +Definition sb (z:V) : V := fun A r a => r (z A r) a. +Definition le (i:U -> Type) (x:U) : Type := x (fun A r a => i (fun v => sb v A r a)). +Definition le' (i:up (down U) -> Type) (x:up (down U)) : Type := le (fun a:U => i (forth _ a)) (back _ x). +Definition induct (i:U -> Type) : Type := forall x:U, up (le i x) -> up (i x). +Definition WF : U := fun z => down (induct (fun a => z (down U) le' (forth _ a))). +Definition I (x:U) : Type := + (forall i:U -> Type, up (le i x) -> up (i (fun v => sb v (down U) le' (forth _ x)))) -> False. + +Lemma Omega : forall i:U -> Type, induct i -> up (i WF). +Proof. +intros i y. +apply y. +unfold le, WF, induct. +apply forth. +intros x H0. +apply y. +unfold sb, le', le. +compute. +apply backforth_r. +exact H0. +Qed. + +Lemma lemma1 : induct (fun u => down (I u)). +Proof. +unfold induct. +intros x p. +apply forth. +intro q. +generalize (q (fun u => down (I u)) p). +intro r. +apply back in r. +apply r. +intros i j. +unfold le, sb, le', le in j |-. +apply backforth in j. +specialize q with (i := fun y => i (fun v:V => sb v (down U) le' (forth _ y))). +apply q. +exact j. +Qed. + +Lemma lemma2 : (forall i:U -> Type, induct i -> up (i WF)) -> False. +Proof. +intro x. +generalize (x (fun u => down (I u)) lemma1). +intro r; apply back in r. +apply r. +intros i H0. +apply (x (fun y => i (fun v => sb v (down U) le' (forth _ y)))). +unfold le, WF in H0. +apply back in H0. +exact H0. +Qed. + +Theorem paradox : False. +Proof. +exact (lemma2 Omega). +Qed. + +End Hurkens. + +Polymorphic Record box (T : Type) := wrap {unwrap : T}. + +(* Here we instantiate to Set *) + +Fail Definition down (x : Type) : Prop := box x. +Definition up (x : Prop) : Type := x. + +Fail Definition back A : up (down A) -> A := unwrap A. + +Fail Definition forth A : A -> up (down A) := wrap A. + +Definition id {A : Type} (a : A) := a. +Definition setlt (A : Type@{i}) := + let foo := Type@{i} : Type@{j} in True. + +Definition setle (B : Type@{i}) := + let foo (A : Type@{j}) := A in foo B. + +Fail Check @setlt@{j Prop}. +Fail Definition foo := @setle@{j Prop}. +Check setlt@{Set i}. +Check setlt@{Set j}. diff --git a/test-suite/bugs/closed/bug_4292.v b/test-suite/bugs/closed/bug_4292.v new file mode 100644 index 0000000000..403e155eaf --- /dev/null +++ b/test-suite/bugs/closed/bug_4292.v @@ -0,0 +1,7 @@ +Module Type S. End S. + +Declare Module M : S. + +Module Type F (T: S). End F. + +Fail Module Type N := F with Module T := M. diff --git a/test-suite/bugs/closed/bug_4293.v b/test-suite/bugs/closed/bug_4293.v new file mode 100644 index 0000000000..21d333fa63 --- /dev/null +++ b/test-suite/bugs/closed/bug_4293.v @@ -0,0 +1,7 @@ +Module Type Foo. +Definition T := let X := Type in Type. +End Foo. + +Module M : Foo. +Definition T := let X := Type in Type. +End M. diff --git a/test-suite/bugs/closed/bug_4294.v b/test-suite/bugs/closed/bug_4294.v new file mode 100644 index 0000000000..1d5e3c71b8 --- /dev/null +++ b/test-suite/bugs/closed/bug_4294.v @@ -0,0 +1,31 @@ +Require Import Hurkens. + +Module NonPoly. +Module Type Foo. + Definition U := Type. + Parameter eq : Type = U. +End Foo. + +Module M : Foo with Definition U := Type. + Definition U := Type. + Definition eq : Type = U := eq_refl. +End M. + +Print Universes. +Fail Definition bad : False := TypeNeqSmallType.paradox M.U M.eq. +End NonPoly. + +Set Universe Polymorphism. + +Module Type Foo. + Definition U := Type. + Monomorphic Parameter eq : Type = U. +End Foo. + +Module M : Foo with Definition U := Type. + Definition U := Type. + Monomorphic Definition eq : Type = U := eq_refl. +End M. + +Fail Definition bad : False := TypeNeqSmallType.paradox Type M.eq. +(* Print Assumptions bad. *) diff --git a/test-suite/bugs/closed/bug_4298.v b/test-suite/bugs/closed/bug_4298.v new file mode 100644 index 0000000000..875612ddf4 --- /dev/null +++ b/test-suite/bugs/closed/bug_4298.v @@ -0,0 +1,7 @@ +Set Universe Polymorphism. + +Module Type Foo. + Definition U := Type. +End Foo. + +Fail Module M : Foo with Definition U := Prop. diff --git a/test-suite/bugs/closed/bug_4299.v b/test-suite/bugs/closed/bug_4299.v new file mode 100644 index 0000000000..a1daa193ae --- /dev/null +++ b/test-suite/bugs/closed/bug_4299.v @@ -0,0 +1,12 @@ +Unset Strict Universe Declaration. +Set Universe Polymorphism. + +Module Type Foo. + Definition U := Type : Type. + Parameter eq : Type = U. +End Foo. + +Module M : Foo with Definition U := Type : Type. + Definition U := let X := Type in Type. + Definition eq : Type = U := eq_refl. +Fail End M. diff --git a/test-suite/bugs/closed/bug_4301.v b/test-suite/bugs/closed/bug_4301.v new file mode 100644 index 0000000000..2b942371fe --- /dev/null +++ b/test-suite/bugs/closed/bug_4301.v @@ -0,0 +1,13 @@ +Unset Strict Universe Declaration. +Set Universe Polymorphism. + +Module Type Foo. + Parameter U : Type. +End Foo. + +Module Lower (X : Foo with Definition U := True : Type). +End Lower. + +Module M : Foo. + Definition U := nat : Type@{i}. +End M. diff --git a/test-suite/bugs/closed/bug_4305.v b/test-suite/bugs/closed/bug_4305.v new file mode 100644 index 0000000000..39fc02d22b --- /dev/null +++ b/test-suite/bugs/closed/bug_4305.v @@ -0,0 +1,17 @@ +(* Check fallback when an abbreviation is not interpretable as a pattern *) + +Notation foo := Type. + +Definition t := + match 0 with + | S foo => foo + | _ => 0 + end. + +Notation bar := (option Type). + +Definition u := + match 0 with + | S bar => bar + | _ => 0 + end. diff --git a/test-suite/bugs/closed/bug_4306.v b/test-suite/bugs/closed/bug_4306.v new file mode 100644 index 0000000000..80c348d207 --- /dev/null +++ b/test-suite/bugs/closed/bug_4306.v @@ -0,0 +1,32 @@ +Require Import List. +Require Import Arith. +Require Import Recdef. +Require Import Omega. + +Function foo (xys : (list nat * list nat)) {measure (fun xys => length (fst xys) + length (snd xys))} : list nat := + match xys with + | (nil, _) => snd xys + | (_, nil) => fst xys + | (x :: xs', y :: ys') => match Nat.compare x y with + | Lt => x :: foo (xs', y :: ys') + | Eq => x :: foo (xs', ys') + | Gt => y :: foo (x :: xs', ys') + end + end. +Proof. + intros; simpl; omega. + intros; simpl; omega. + intros; simpl; omega. +Qed. + +Function bar (xys : (list nat * list nat)) {measure (fun xys => length (fst xys) + length (snd xys))} : list nat := + let (xs, ys) := xys in + match (xs, ys) with + | (nil, _) => ys + | (_, nil) => xs + | (x :: xs', y :: ys') => match Nat.compare x y with + | Lt => x :: foo (xs', ys) + | Eq => x :: foo (xs', ys') + | Gt => y :: foo (xs, ys') + end + end. diff --git a/test-suite/bugs/closed/bug_4316.v b/test-suite/bugs/closed/bug_4316.v new file mode 100644 index 0000000000..68dec1334a --- /dev/null +++ b/test-suite/bugs/closed/bug_4316.v @@ -0,0 +1,3 @@ +Ltac tac := idtac. +Reset tac. +Ltac tac := idtac. diff --git a/test-suite/bugs/closed/bug_4318.v b/test-suite/bugs/closed/bug_4318.v new file mode 100644 index 0000000000..e3140ed5ab --- /dev/null +++ b/test-suite/bugs/closed/bug_4318.v @@ -0,0 +1,2 @@ +(* Check no anomaly is raised *) +Fail Definition foo p := match p with (x, y) z => tt end. diff --git a/test-suite/bugs/closed/bug_4325.v b/test-suite/bugs/closed/bug_4325.v new file mode 100644 index 0000000000..af69ca04b6 --- /dev/null +++ b/test-suite/bugs/closed/bug_4325.v @@ -0,0 +1,5 @@ +Goal (forall a b : nat, Set = (a = b)) -> Set. +Proof. + clear. + intro H. + erewrite (fun H' => H _ H'). diff --git a/test-suite/bugs/closed/bug_4328.v b/test-suite/bugs/closed/bug_4328.v new file mode 100644 index 0000000000..b40b3a4830 --- /dev/null +++ b/test-suite/bugs/closed/bug_4328.v @@ -0,0 +1,6 @@ +Inductive M (A:Type) : Type := M'. +Axiom pi : forall (P : Prop) (p : P), Prop. +Definition test1 A (x : _) := pi A x. (* success *) +Fail Definition test2 A (x : A) := pi A x. (* failure ??? *) +Fail Definition test3 A (x : A) (_ : M A) := pi A x. (* failure *) +Fail Definition test4 A (_ : M A) (x : A) := pi A x. (* success ??? *) diff --git a/test-suite/bugs/closed/bug_4346.v b/test-suite/bugs/closed/bug_4346.v new file mode 100644 index 0000000000..b50dff2411 --- /dev/null +++ b/test-suite/bugs/closed/bug_4346.v @@ -0,0 +1,2 @@ +Check (Set <: Type). +Check (Set <<: Type). diff --git a/test-suite/bugs/closed/bug_4347.v b/test-suite/bugs/closed/bug_4347.v new file mode 100644 index 0000000000..29686a26c1 --- /dev/null +++ b/test-suite/bugs/closed/bug_4347.v @@ -0,0 +1,17 @@ +Fixpoint demo_recursion(n:nat) := match n with + |0 => Type + |S k => (demo_recursion k) -> Type + end. + +Record Demonstration := mkDemo +{ + demo_law : forall n:nat, demo_recursion n; + demo_stuff : forall n:nat, forall q:(fix demo_recursion (n : nat) : Type := + match n with + | 0 => Type + | S k => demo_recursion k -> Type + end) n, (demo_law (S n)) q +}. + +Theorem DemoError : Demonstration. +Fail apply mkDemo. (*Anomaly: Uncaught exception Not_found. Please report.*) diff --git a/test-suite/bugs/closed/bug_4354.v b/test-suite/bugs/closed/bug_4354.v new file mode 100644 index 0000000000..c55b4cf02a --- /dev/null +++ b/test-suite/bugs/closed/bug_4354.v @@ -0,0 +1,11 @@ +Inductive True : Prop := I. +Class Lift (T : Type). +Axiom closed_increment : forall {T} {H : Lift T}, True. +Create HintDb core. +Lemma closed_monotonic T (H : Lift T) : True. +Proof. + Set Printing Universes. + auto using closed_increment. Show Universes. +Qed. +(* also fails with -nois, so the content of the hint database does not matter +*) diff --git a/test-suite/bugs/closed/bug_4363.v b/test-suite/bugs/closed/bug_4363.v new file mode 100644 index 0000000000..9895548c1d --- /dev/null +++ b/test-suite/bugs/closed/bug_4363.v @@ -0,0 +1,9 @@ +Set Printing Universes. +Definition foo : Type. +Proof. + assert (H : Set) by abstract (assert Type by abstract exact Type using bar; exact nat). + exact bar. +Defined. (* Toplevel input, characters 0-8: +Error: +The term "(fun _ : Set => bar) foo_subproof" has type +"Type@{Top.2}" while it is expected to have type "Type@{Top.1}". *) diff --git a/test-suite/bugs/closed/bug_4366.v b/test-suite/bugs/closed/bug_4366.v new file mode 100644 index 0000000000..403c2d2026 --- /dev/null +++ b/test-suite/bugs/closed/bug_4366.v @@ -0,0 +1,15 @@ +Fixpoint stupid (n : nat) : unit := +match n with +| 0 => tt +| S n => + let () := stupid n in + let () := stupid n in + tt +end. + +Goal True. +Proof. +pose (v := stupid 24). +Timeout 4 vm_compute in v. +exact I. +Qed. diff --git a/test-suite/bugs/closed/bug_4372.v b/test-suite/bugs/closed/bug_4372.v new file mode 100644 index 0000000000..428192a344 --- /dev/null +++ b/test-suite/bugs/closed/bug_4372.v @@ -0,0 +1,20 @@ +(* Tactic inversion was raising an anomaly because of a fake + dependency of TypeDenote into its argument *) + +Inductive expr := +| ETrue. + +Inductive IntermediateType : Set := ITbool. + +Definition TypeDenote (IT : IntermediateType) : Type := + match IT with + | _ => bool + end. + +Inductive ValueDenote : forall (e:expr) it, TypeDenote it -> Prop := +| VT : ValueDenote ETrue ITbool true. + +Goal forall it v, @ValueDenote ETrue it v -> True. + intros it v H. + inversion H. +Abort. diff --git a/test-suite/bugs/closed/bug_4375.v b/test-suite/bugs/closed/bug_4375.v new file mode 100644 index 0000000000..ef358b15e0 --- /dev/null +++ b/test-suite/bugs/closed/bug_4375.v @@ -0,0 +1,106 @@ + + +Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} := + t. + + +Module A. +Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => foo t n + end. +End A. + +Module B. +Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar@{i} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => foo t n + end. +End B. + +Module C. +Fail Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar@{j} (t : Type@{j}) (n : nat) : Type@{j} := + match n with + | 0 => t + | S n => foo t n + end. +End C. + +Module D. +Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar@{i j} (t : Type@{j}) (n : nat) : Type@{j} := + match n with + | 0 => t + | S n => foo t n + end. +End D. + +Module E. +Fail Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar@{j i} (t : Type@{j}) (n : nat) : Type@{j} := + match n with + | 0 => t + | S n => foo t n + end. +End E. + +(* +Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} := + t. + +Print g. + +Polymorphic Fixpoint a@{i} (t : Type@{i}) (n : nat) : Type@{i} := + t +with b@{i} (t : Type@{i}) (n : nat) : Type@{i} := + t. + +Print a. +Print b. +*) + +Polymorphic CoInductive foo@{i} (T : Type@{i}) : Type@{i} := +| A : foo T -> foo T. + +Polymorphic CoFixpoint cg@{i} (t : Type@{i}) : foo@{i} t := + @A@{i} t (cg t). + +Print cg. + +Polymorphic CoFixpoint ca@{i} (t : Type@{i}) : foo@{i} t := + @A@{i} t (cb t) +with cb@{i} (t : Type@{i}) : foo@{i} t := + @A@{i} t (ca t). + +Print ca. +Print cb. diff --git a/test-suite/bugs/closed/bug_4378.v b/test-suite/bugs/closed/bug_4378.v new file mode 100644 index 0000000000..9d59165562 --- /dev/null +++ b/test-suite/bugs/closed/bug_4378.v @@ -0,0 +1,9 @@ +Tactic Notation "epose" open_constr(a) := + let a' := fresh in + pose a as a'. +Tactic Notation "epose2" open_constr(a) tactic3(tac) := + let a' := fresh in + pose a as a'. +Goal True. + epose _. Undo. + epose2 _ idtac. diff --git a/test-suite/bugs/closed/bug_4390.v b/test-suite/bugs/closed/bug_4390.v new file mode 100644 index 0000000000..c069b2d9dc --- /dev/null +++ b/test-suite/bugs/closed/bug_4390.v @@ -0,0 +1,37 @@ +Module A. +Set Printing All. +Set Printing Universes. + +Module M. +Section foo. +Universe i. +End foo. +End M. + +Check Type@{M.i}. +(* Succeeds *) + +Fail Check Type@{j}. +(* Error: Undeclared universe: j *) + +Definition foo@{j} : Type@{M.i} := Type@{j}. +(* ok *) +End A. +Import A. Import M. +Set Universe Polymorphism. +Fail Universes j. +Monomorphic Universe j. +Section foo. + Universes i. + Constraint i < j. + Definition foo : Type@{j} := Type@{i}. + Definition foo' : Type@{j} := Type@{i}. +End foo. + +Check eq_refl : foo@{i} = foo'@{i}. + +Definition bar := foo. +Monomorphic Definition bar'@{k} := foo@{k}. + +Fail Constraint j = j. +Monomorphic Constraint i = i. diff --git a/test-suite/bugs/closed/bug_4397.v b/test-suite/bugs/closed/bug_4397.v new file mode 100644 index 0000000000..3566353d84 --- /dev/null +++ b/test-suite/bugs/closed/bug_4397.v @@ -0,0 +1,3 @@ +Require Import Equality. +Theorem foo (u : unit) (H : u = u) : True. +dependent destruction H. diff --git a/test-suite/bugs/closed/bug_4403.v b/test-suite/bugs/closed/bug_4403.v new file mode 100644 index 0000000000..a80f38fe2a --- /dev/null +++ b/test-suite/bugs/closed/bug_4403.v @@ -0,0 +1,3 @@ +(* -*- coq-prog-args: ("-type-in-type"); -*- *) + +Definition some_prop : Prop := Type. diff --git a/test-suite/bugs/closed/bug_4404.v b/test-suite/bugs/closed/bug_4404.v new file mode 100644 index 0000000000..38fed1936c --- /dev/null +++ b/test-suite/bugs/closed/bug_4404.v @@ -0,0 +1,3 @@ +Inductive Foo : Type -> Type := foo A : Foo A. +Goal True. + remember Foo. diff --git a/test-suite/bugs/closed/bug_4412.v b/test-suite/bugs/closed/bug_4412.v new file mode 100644 index 0000000000..4b2aae0c7b --- /dev/null +++ b/test-suite/bugs/closed/bug_4412.v @@ -0,0 +1,4 @@ +Require Import Coq.Bool.Bool Coq.Setoids.Setoid. +Goal forall (P : forall b : bool, b = true -> Type) (x y : bool) (H : andb x y = true) (H' : P _ H), True. + intros. + Fail rewrite Bool.andb_true_iff in H. diff --git a/test-suite/bugs/closed/bug_4416.v b/test-suite/bugs/closed/bug_4416.v new file mode 100644 index 0000000000..62b90b4286 --- /dev/null +++ b/test-suite/bugs/closed/bug_4416.v @@ -0,0 +1,4 @@ +Goal exists x, x. +Unset Solve Unification Constraints. +unshelve refine (ex_intro _ _ _); match goal with _ => refine (_ _) end. +(* Error: Incorrect number of goals (expected 2 tactics). *) diff --git a/test-suite/bugs/closed/bug_4420.v b/test-suite/bugs/closed/bug_4420.v new file mode 100644 index 0000000000..b81185a555 --- /dev/null +++ b/test-suite/bugs/closed/bug_4420.v @@ -0,0 +1,18 @@ +Module foo. + Context (Char : Type). + Axiom foo : Type -> Type. + Goal foo Char = foo Char. + change foo with (fun x => foo x). + cbv beta. + reflexivity. + Defined. +End foo. + +Inductive foo (A : Type) : Prop := I. (*Top.1*) +Lemma bar : foo Type. (*Top.3*) +Proof. + Set Printing Universes. +change foo with (fun x : Type => foo x). (*Top.4*) +cbv beta. +apply I. (* I Type@{Top.3} : (fun x : Type@{Top.4} => foo x) Type@{Top.3} *) +Defined. diff --git a/test-suite/bugs/closed/bug_4429.v b/test-suite/bugs/closed/bug_4429.v new file mode 100644 index 0000000000..bf0e570ab8 --- /dev/null +++ b/test-suite/bugs/closed/bug_4429.v @@ -0,0 +1,31 @@ +Require Import Arith.Compare_dec. +Require Import Unicode.Utf8. + +Fixpoint my_nat_iter (n : nat) {A} (f : A → A) (x : A) : A := + match n with + | O => x + | S n' => f (my_nat_iter n' f x) + end. + +Definition gcd_IT_F (f : nat * nat → nat) (mn : nat * nat) : nat := + match mn with + | (0, 0) => 0 + | (0, S n') => S n' + | (S m', 0) => S m' + | (S m', S n') => + match le_gt_dec (S m') (S n') with + | left _ => f (S m', S n' - S m') + | right _ => f (S m' - S n', S n') + end + end. + +Axiom max_correct_l : ∀ m n : nat, m <= max m n. +Axiom max_correct_r : ∀ m n : nat, n <= max m n. + +Hint Resolve max_correct_l max_correct_r : arith. + +Theorem foo : ∀ p p' p'' : nat, p'' < S (max p (max p' p'')). +Proof. + intros. + Timeout 3 eauto with arith. +Qed. diff --git a/test-suite/bugs/closed/bug_4433.v b/test-suite/bugs/closed/bug_4433.v new file mode 100644 index 0000000000..83c0e3f81f --- /dev/null +++ b/test-suite/bugs/closed/bug_4433.v @@ -0,0 +1,29 @@ +Require Import Coq.Arith.Arith Coq.Init.Wf. +Axiom proof_admitted : False. +Goal exists x y z : nat, Fix + Wf_nat.lt_wf + (fun _ => nat -> nat) + (fun x' f => match x' as x'0 + return match x'0 with + | 0 => True + | S x'' => x'' < x' + end + -> nat -> nat + with + | 0 => fun _ _ => 0 + | S x'' => f x'' + end + (match x' with + | 0 => I + | S x'' => (Nat.lt_succ_diag_r _) + end)) + z + y + = 0. +Proof. + do 3 (eexists; [ shelve.. | ]). + match goal with |- ?G => let G' := (eval lazy in G) in change G with G' end. + case proof_admitted. + Unshelve. + all:constructor. +Defined. diff --git a/test-suite/bugs/closed/bug_4443.v b/test-suite/bugs/closed/bug_4443.v new file mode 100644 index 0000000000..a3a8717d98 --- /dev/null +++ b/test-suite/bugs/closed/bug_4443.v @@ -0,0 +1,31 @@ +Set Universe Polymorphism. + +Record TYPE@{i} := cType { + type : Type@{i}; +}. + +Definition PROD@{i j k} + (A : Type@{i}) + (B : A -> Type@{j}) + : TYPE@{k}. +Proof. + refine (cType@{i} _). ++ refine (forall x : A, B x). +Defined. + +Local Unset Strict Universe Declaration. +Definition PRODinj + (A : Type@{i}) + (B : A -> Type) + : TYPE. +Proof. + refine (cType@{i} _). ++ refine (forall x : A, B x). +Defined. + + Monomorphic Universe i j. + Monomorphic Constraint j < i. +Set Printing Universes. +Check PROD@{i i i}. +Check PRODinj@{i j}. +Fail Check PRODinj@{j i}. diff --git a/test-suite/bugs/closed/bug_4450.v b/test-suite/bugs/closed/bug_4450.v new file mode 100644 index 0000000000..c1fe44315a --- /dev/null +++ b/test-suite/bugs/closed/bug_4450.v @@ -0,0 +1,58 @@ +Polymorphic Axiom inhabited@{u} : Type@{u} -> Prop. + +Polymorphic Axiom unit@{u} : Type@{u}. +Polymorphic Axiom tt@{u} : inhabited unit@{u}. + +Polymorphic Hint Resolve tt : the_lemmas. +Set Printing All. +Set Printing Universes. +Goal inhabited unit. +Proof. + eauto with the_lemmas. +Qed. + +Universe u. +Axiom f : Type@{u} -> Prop. +Lemma fapp (X : Type) : f X -> False. +Admitted. +Polymorphic Axiom funi@{i} : f unit@{i}. + +Goal (forall U, f U) -> (*(f unit -> False) -> *)False /\ False. + eauto using (fapp unit funi). (* The two fapp's have different universes *) +Qed. + +Hint Resolve (fapp unit funi) : mylems. + +Goal (forall U, f U) -> (*(f unit -> False) -> *)False /\ False. + eauto with mylems. (* Forces the two fapps at the same level *) +Qed. + +Goal (forall U, f U) -> (f unit -> False) -> False /\ False. + eauto. (* Forces the two fapps at the same level *) +Qed. + +Polymorphic Definition MyType@{i} := Type@{i}. +Universes l m n. +Constraint l < m. +Polymorphic Axiom maketype@{i} : MyType@{i}. + +Goal MyType@{l}. +Proof. + Fail solve [ eauto using maketype@{m} ]. + eauto using maketype. + Undo. + eauto using maketype@{n}. +Qed. + +Axiom foo : forall (A : Type), list A. +Polymorphic Axiom foop@{i} : forall (A : Type@{i}), list A. + +Universe x y. +Goal list Type@{x}. +Proof. + eauto using (foo Type). (* Refreshes the term *) + Undo. + eauto using foo. Show Universes. + Undo. + eauto using foop. Show Proof. Show Universes. +Qed. diff --git a/test-suite/bugs/closed/bug_4453.v b/test-suite/bugs/closed/bug_4453.v new file mode 100644 index 0000000000..009dd5e3ca --- /dev/null +++ b/test-suite/bugs/closed/bug_4453.v @@ -0,0 +1,8 @@ + +Section Foo. +Variable A : Type. +Lemma foo : A -> True. now intros _. Qed. +Goal Type -> True. +rename A into B. +intros A. +Fail apply foo. diff --git a/test-suite/bugs/closed/bug_4456.v b/test-suite/bugs/closed/bug_4456.v new file mode 100644 index 0000000000..56a7b4f6e9 --- /dev/null +++ b/test-suite/bugs/closed/bug_4456.v @@ -0,0 +1,647 @@ +(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerMin" "-R" "." "Top") -*- *) +(* File reduced by coq-bug-finder from original input, then from 2475 lines to 729 lines, then from 746 lines to 658 lines, then from 675 lines to 658 lines *) +(* coqc version 8.5beta3 (November 2015) compiled on Nov 11 2015 18:23:0 with OCaml 4.01.0 + coqtop version 8.5beta3 (November 2015) *) +(* Variable P : forall n m : nat, n = m -> Prop. *) +(* Axiom Prefl : forall n : nat, P n n eq_refl. *) +Axiom proof_admitted : False. + +Tactic Notation "admit" := case proof_admitted. + +Require Coq.Program.Program. +Require Coq.Strings.String. +Require Coq.omega.Omega. +Module Export Fiat_DOT_Common. +Module Export Fiat. +Module Common. +Import Coq.Lists.List. +Export Coq.Program.Program. + +Global Set Implicit Arguments. + +Global Coercion is_true : bool >-> Sortclass. +Coercion bool_of_sum {A B} (b : sum A B) : bool := if b then true else false. + +Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type + := match ls return Type with + | nil => True + | x::xs => (P x * ForallT P xs)%type + end. +Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type + := match ls with + | nil => P nil + | x::xs => (P (x::xs) * Forall_tails P xs)%type + end. + +End Common. + +End Fiat. + +End Fiat_DOT_Common. +Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Core. +Module Export Fiat. +Module Export Parsers. +Module Export StringLike. +Module Export Core. +Import Coq.Relations.Relation_Definitions. +Import Coq.Classes.Morphisms. + +Local Coercion is_true : bool >-> Sortclass. + +Module Export StringLike. + Class StringLike {Char : Type} := + { + String :> Type; + is_char : String -> Char -> bool; + length : String -> nat; + take : nat -> String -> String; + drop : nat -> String -> String; + get : nat -> String -> option Char; + unsafe_get : nat -> String -> Char; + bool_eq : String -> String -> bool; + beq : relation String := fun x y => bool_eq x y + }. + + Arguments StringLike : clear implicits. + Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope. + Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope. + Local Open Scope string_like_scope. + + Class StringLikeProperties (Char : Type) `{StringLike Char} := + { + singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch'; + singleton_exists : forall s, length s = 1 -> exists ch, s ~= [ ch ]; + get_0 : forall s ch, take 1 s ~= [ ch ] <-> get 0 s = Some ch; + get_S : forall n s, get (S n) s = get n (drop 1 s); + unsafe_get_correct : forall n s ch, get n s = Some ch -> unsafe_get n s = ch; + length_singleton : forall s ch, s ~= [ ch ] -> length s = 1; + bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s'; + is_char_Proper :> Proper (beq ==> eq ==> eq) is_char; + length_Proper :> Proper (beq ==> eq) length; + take_Proper :> Proper (eq ==> beq ==> beq) take; + drop_Proper :> Proper (eq ==> beq ==> beq) drop; + bool_eq_Equivalence :> Equivalence beq; + bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str'; + take_short_length : forall str n, n <= length str -> length (take n str) = n; + take_long : forall str n, length str <= n -> take n str =s str; + take_take : forall str n m, take n (take m str) =s take (min n m) str; + drop_length : forall str n, length (drop n str) = length str - n; + drop_0 : forall str, drop 0 str =s str; + drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str; + drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str); + take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str); + bool_eq_from_get : forall str str', (forall n, get n str = get n str') -> str =s str' + }. +Global Arguments StringLikeProperties _ {_}. +End StringLike. + +End Core. + +End StringLike. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_StringLike_DOT_Core. + +Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core. +Module Export Fiat. +Module Export Parsers. +Module Export ContextFreeGrammar. +Module Export Core. +Import Coq.Strings.String. +Import Coq.Lists.List. +Export Fiat.Parsers.StringLike.Core. + +Section cfg. + Context {Char : Type}. + + Section definitions. + + Inductive item := + | Terminal (_ : Char) + | NonTerminal (_ : string). + + Definition production := list item. + Definition productions := list production. + + Record grammar := + { + Start_symbol :> string; + Lookup :> string -> productions; + Start_productions :> productions := Lookup Start_symbol; + Valid_nonterminals : list string; + Valid_productions : list productions := map Lookup Valid_nonterminals + }. + End definitions. + + End cfg. + +Arguments item _ : clear implicits. +Arguments production _ : clear implicits. +Arguments productions _ : clear implicits. +Arguments grammar _ : clear implicits. + +End Core. + +End ContextFreeGrammar. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core. + +Module Export Fiat_DOT_Parsers_DOT_BaseTypes. +Module Export Fiat. +Module Export Parsers. +Module Export BaseTypes. +Import Coq.Arith.Wf_nat. + +Local Coercion is_true : bool >-> Sortclass. + +Section recursive_descent_parser. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + + Class parser_computational_predataT := + { nonterminals_listT : Type; + nonterminal_carrierT : Type; + of_nonterminal : String.string -> nonterminal_carrierT; + to_nonterminal : nonterminal_carrierT -> String.string; + initial_nonterminals_data : nonterminals_listT; + nonterminals_length : nonterminals_listT -> nat; + is_valid_nonterminal : nonterminals_listT -> nonterminal_carrierT -> bool; + remove_nonterminal : nonterminals_listT -> nonterminal_carrierT -> nonterminals_listT }. + + Class parser_removal_dataT' `{predata : parser_computational_predataT} := + { nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop + := ltof _ nonterminals_length; + nonterminals_length_zero : forall ls, + nonterminals_length ls = 0 + -> forall nt, is_valid_nonterminal ls nt = false; + remove_nonterminal_dec : forall ls nonterminal, + is_valid_nonterminal ls nonterminal + -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; + remove_nonterminal_noninc : forall ls nonterminal, + ~nonterminals_listT_R ls (remove_nonterminal ls nonterminal); + initial_nonterminals_correct : forall nonterminal, + is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal) <-> List.In nonterminal (Valid_nonterminals G); + initial_nonterminals_correct' : forall nonterminal, + is_valid_nonterminal initial_nonterminals_data nonterminal <-> List.In (to_nonterminal nonterminal) (Valid_nonterminals G); + to_of_nonterminal : forall nonterminal, + List.In nonterminal (Valid_nonterminals G) + -> to_nonterminal (of_nonterminal nonterminal) = nonterminal; + of_to_nonterminal : forall nonterminal, + is_valid_nonterminal initial_nonterminals_data nonterminal + -> of_nonterminal (to_nonterminal nonterminal) = nonterminal; + ntl_wf : well_founded nonterminals_listT_R + := well_founded_ltof _ _; + remove_nonterminal_1 + : forall ls ps ps', + is_valid_nonterminal (remove_nonterminal ls ps) ps' + -> is_valid_nonterminal ls ps'; + remove_nonterminal_2 + : forall ls ps ps', + is_valid_nonterminal (remove_nonterminal ls ps) ps' = false + <-> is_valid_nonterminal ls ps' = false \/ ps = ps' }. + + Class split_dataT := + { split_string_for_production + : item Char -> production Char -> String -> list nat }. + + Class boolean_parser_dataT := + { predata :> parser_computational_predataT; + split_data :> split_dataT }. +End recursive_descent_parser. + +End BaseTypes. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_BaseTypes. + +Module Export Fiat_DOT_Common_DOT_List_DOT_Operations. +Module Export Fiat. +Module Export Common. +Module Export List. +Module Export Operations. + +Import Coq.Lists.List. + +Module Export List. + Section InT. + Context {A : Type} (a : A). + + Fixpoint InT (ls : list A) : Set + := match ls return Set with + | nil => False + | b :: m => (b = a) + InT m + end%type. + End InT. + + End List. + +End Operations. + +End List. + +End Common. + +End Fiat. + +End Fiat_DOT_Common_DOT_List_DOT_Operations. + +Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties. +Module Export Fiat. +Module Export Parsers. +Module Export StringLike. +Module Export Properties. + +Section String. + Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char}. + + Lemma take_length {str n} + : length (take n str) = min n (length str). +admit. +Defined. + + End String. + +End Properties. + +End StringLike. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties. + +Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties. +Module Export Fiat. +Module Export Parsers. +Module Export ContextFreeGrammar. +Module Export Properties. + +Local Open Scope list_scope. +Definition production_is_reachableT {Char} (G : grammar Char) (p : production Char) + := { nt : _ + & { prefix : _ + & List.In nt (Valid_nonterminals G) + * List.InT + (prefix ++ p) + (Lookup G nt) } }%type. + +End Properties. + +End ContextFreeGrammar. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties. + +Module Export Fiat_DOT_Parsers_DOT_MinimalParse. +Module Export Fiat. +Module Export Parsers. +Module Export MinimalParse. +Import Coq.Lists.List. +Import Fiat.Parsers.ContextFreeGrammar.Core. + +Local Coercion is_true : bool >-> Sortclass. +Local Open Scope string_like_scope. + +Section cfg. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + Context {predata : @parser_computational_predataT} + {rdata' : @parser_removal_dataT' _ G predata}. + + Inductive minimal_parse_of + : forall (len0 : nat) (valid : nonterminals_listT) + (str : String), + productions Char -> Type := + | MinParseHead : forall len0 valid str pat pats, + @minimal_parse_of_production len0 valid str pat + -> @minimal_parse_of len0 valid str (pat::pats) + | MinParseTail : forall len0 valid str pat pats, + @minimal_parse_of len0 valid str pats + -> @minimal_parse_of len0 valid str (pat::pats) + with minimal_parse_of_production + : forall (len0 : nat) (valid : nonterminals_listT) + (str : String), + production Char -> Type := + | MinParseProductionNil : forall len0 valid str, + length str = 0 + -> @minimal_parse_of_production len0 valid str nil + | MinParseProductionCons : forall len0 valid str n pat pats, + length str <= len0 + -> @minimal_parse_of_item len0 valid (take n str) pat + -> @minimal_parse_of_production len0 valid (drop n str) pats + -> @minimal_parse_of_production len0 valid str (pat::pats) + with minimal_parse_of_item + : forall (len0 : nat) (valid : nonterminals_listT) + (str : String), + item Char -> Type := + | MinParseTerminal : forall len0 valid str ch, + str ~= [ ch ] + -> @minimal_parse_of_item len0 valid str (Terminal ch) + | MinParseNonTerminal + : forall len0 valid str (nt : String.string), + @minimal_parse_of_nonterminal len0 valid str nt + -> @minimal_parse_of_item len0 valid str (NonTerminal nt) + with minimal_parse_of_nonterminal + : forall (len0 : nat) (valid : nonterminals_listT) + (str : String), + String.string -> Type := + | MinParseNonTerminalStrLt + : forall len0 valid (nt : String.string) str, + length str < len0 + -> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt) + -> @minimal_parse_of (length str) initial_nonterminals_data str (Lookup G nt) + -> @minimal_parse_of_nonterminal len0 valid str nt + | MinParseNonTerminalStrEq + : forall len0 str valid nonterminal, + length str = len0 + -> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal) + -> is_valid_nonterminal valid (of_nonterminal nonterminal) + -> @minimal_parse_of len0 (remove_nonterminal valid (of_nonterminal nonterminal)) str (Lookup G nonterminal) + -> @minimal_parse_of_nonterminal len0 valid str nonterminal. + +End cfg. + +End MinimalParse. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_MinimalParse. + +Module Export Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes. +Module Export Fiat. +Module Export Parsers. +Module Export CorrectnessBaseTypes. +Import Coq.Lists.List. +Import Fiat.Parsers.ContextFreeGrammar.Core. +Import Fiat_DOT_Common.Fiat.Common. +Section general. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + + Definition split_list_completeT_for {data : @parser_computational_predataT} + {len0 valid} + (it : item Char) (its : production Char) + (str : String) + (pf : length str <= len0) + (split_list : list nat) + + := ({ n : nat + & (minimal_parse_of_item (G := G) (predata := data) len0 valid (take n str) it) + * (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type) + -> ({ n : nat + & (In (min (length str) n) (map (min (length str)) split_list)) + * (minimal_parse_of_item (G := G) len0 valid (take n str) it) + * (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type). + + Definition split_list_completeT {data : @parser_computational_predataT} + (splits : item Char -> production Char -> String -> list nat) + := forall len0 valid str (pf : length str <= len0) nt, + is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt) + -> ForallT + (Forall_tails + (fun prod + => match prod return Type with + | nil => True + | it::its + => @split_list_completeT_for data len0 valid it its str pf (splits it its str) + end)) + (Lookup G nt). + + Class boolean_parser_completeness_dataT' {data : boolean_parser_dataT} := + { split_string_for_production_complete + : split_list_completeT split_string_for_production }. +End general. + +End CorrectnessBaseTypes. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes. + +Module Export Fiat. +Module Export Parsers. +Module Export ContextFreeGrammar. +Module Export Valid. +Export Fiat.Parsers.StringLike.Core. + +Section cfg. + Context {Char : Type} {HSL : StringLike Char} (G : grammar Char) + {predata : parser_computational_predataT}. + + Definition item_valid (it : item Char) + := match it with + | Terminal _ => True + | NonTerminal nt' => is_true (is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt')) + end. + + Definition production_valid pat + := List.Forall item_valid pat. + + Definition productions_valid pats + := List.Forall production_valid pats. + + Definition grammar_valid + := forall nt, + List.In nt (Valid_nonterminals G) + -> productions_valid (Lookup G nt). +End cfg. + +End Valid. + +Section app. + Context {Char : Type} {HSL : StringLike Char} (G : grammar Char) + {predata : parser_computational_predataT}. + + Lemma hd_production_valid + (it : item Char) + (its : production Char) + (H : production_valid (it :: its)) + : item_valid it. +admit. +Defined. + + Lemma production_valid_cons + (it : item Char) + (its : production Char) + (H : production_valid (it :: its)) + : production_valid its. +admit. +Defined. + + End app. + +Import Coq.Lists.List. +Import Coq.omega.Omega. +Import Fiat_DOT_Common.Fiat.Common. +Import Fiat.Parsers.ContextFreeGrammar.Valid. +Local Open Scope string_like_scope. + +Section recursive_descent_parser. + Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char). + Context {data : @boolean_parser_dataT Char _} + {cdata : @boolean_parser_completeness_dataT' Char _ G data} + {rdata : @parser_removal_dataT' _ G _} + {gvalid : grammar_valid G}. + + Local Notation dec T := (T + (T -> False))%type (only parsing). + + Local Notation iffT x y := ((x -> y) * (y -> x))%type (only parsing). + + Lemma dec_prod {A B} (HA : dec A) (HB : dec B) : dec (A * B). +admit. +Defined. + + Lemma dec_In {A} {P : A -> Type} (HA : forall a, dec (P a)) ls + : dec { a : _ & (In a ls * P a) }. +admit. +Defined. + + Section item. + Context {len0 valid} + (str : String) + (str_matches_nonterminal' + : nonterminal_carrierT -> bool) + (str_matches_nonterminal + : forall nt : nonterminal_carrierT, + dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))). + + Section valid. + Context (Hmatches + : forall nt, + is_valid_nonterminal initial_nonterminals_data nt + -> str_matches_nonterminal nt = str_matches_nonterminal' nt :> bool) + (it : item Char) + (Hvalid : item_valid it). + + Definition parse_item' + : dec (minimal_parse_of_item (G := G) len0 valid str it). + Proof. + clear Hvalid. + refine (match it return dec (minimal_parse_of_item len0 valid str it) with + | Terminal ch => if Sumbool.sumbool_of_bool (str ~= [ ch ]) + then inl (MinParseTerminal _ _ _ _ _) + else inr (fun _ => !) + | NonTerminal nt => if str_matches_nonterminal (of_nonterminal nt) + then inl (MinParseNonTerminal _) + else inr (fun _ => !) + end); + clear str_matches_nonterminal Hmatches; + admit. + Defined. + End valid. + + End item. + Context {len0 valid} + (parse_nonterminal + : forall (str : String) (len : nat) (Hlen : length str = len) (pf : len <= len0) (nt : nonterminal_carrierT), + dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))). + + Lemma dec_in_helper {ls it its str} + : iffT {n0 : nat & + (In (min (length str) n0) (map (min (length str)) ls) * + minimal_parse_of_item (G := G) len0 valid (take n0 str) it * + minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type} + {n0 : nat & + (In n0 ls * + (minimal_parse_of_item (G := G) len0 valid (take n0 str) it * + minimal_parse_of_production (G := G) len0 valid (drop n0 str) its))%type}. +admit. +Defined. + + Lemma parse_production'_helper {str it its} (pf : length str <= len0) + : dec {n0 : nat & + (minimal_parse_of_item (G := G) len0 valid (take n0 str) it * + minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type} + -> dec (minimal_parse_of_production (G := G) len0 valid str (it :: its)). +admit. +Defined. + Local Ltac t_parse_production_for := repeat + match goal with + | [ H : (beq_nat _ _) = true |- _ ] => apply EqNat.beq_nat_true in H + | _ => progress subst + | _ => solve [ constructor; assumption ] + | [ H : minimal_parse_of_production _ _ _ nil |- _ ] => (inversion H; clear H) + | [ H : minimal_parse_of_production _ _ _ (_::_) |- _ ] => (inversion H; clear H) + | [ H : ?x = 0, H' : context[?x] |- _ ] => rewrite H in H' + | _ => progress simpl in * + | _ => discriminate + | [ H : forall x, (_ * _)%type -> _ |- _ ] => specialize (fun x y z => H x (y, z)) + | _ => solve [ eauto with nocore ] + | _ => solve [ apply Min.min_case_strong; omega ] + | _ => omega + | [ H : production_valid (_::_) |- _ ] + => let H' := fresh in + pose proof H as H'; + apply production_valid_cons in H; + apply hd_production_valid in H' + end. + + Definition parse_production'_for + (splits : item Char -> production Char -> String -> list nat) + (Hsplits : forall str it its (Hreachable : production_is_reachableT G (it::its)) pf', split_list_completeT_for (len0 := len0) (G := G) (valid := valid) it its str pf' (splits it its str)) + (str : String) + (len : nat) + (Hlen : length str = len) + (pf : len <= len0) + (prod : production Char) + (Hreachable : production_is_reachableT G prod) + : dec (minimal_parse_of_production (G := G) len0 valid str prod). + Proof. + revert prod Hreachable str len Hlen pf. + refine + ((fun pf_helper => + list_rect + (fun prod => + forall (Hreachable : production_is_reachableT G prod) + (str : String) + (len : nat) + (Hlen : length str = len) + (pf : len <= len0), + dec (minimal_parse_of_production (G := G) len0 valid str prod)) + ( + fun Hreachable str len Hlen pf + => match Utils.dec (beq_nat len 0) with + | left H => inl _ + | right H => inr (fun p => _) + end) + (fun it its parse_production' Hreachable str len Hlen pf + => parse_production'_helper + _ + (let parse_item := (fun n pf => parse_item' (parse_nonterminal (take n str) (len := min n len) (eq_trans take_length (f_equal (min _) Hlen)) pf) it) in + let parse_item := (fun n => parse_item n (Min.min_case_strong n len (fun k => k <= len0) (fun Hlen => (Nat.le_trans _ _ _ Hlen pf)) (fun Hlen => pf))) in + let parse_production := (fun n => parse_production' (pf_helper it its Hreachable) (drop n str) (len - n) (eq_trans (drop_length _ _) (f_equal (fun x => x - _) Hlen)) (Nat.le_trans _ _ _ (Nat.le_sub_l _ _) pf)) in + match dec_In + (fun n => dec_prod (parse_item n) (parse_production n)) + (splits it its str) + with + | inl p => inl (existT _ (projT1 p) (snd (projT2 p))) + | inr p + => let pf' := (Nat.le_trans _ _ _ (Nat.eq_le_incl _ _ Hlen) pf) in + let H := (_ : split_list_completeT_for (G := G) (len0 := len0) (valid := valid) it its str pf' (splits it its str)) in + inr (fun p' => p (fst dec_in_helper (H p'))) + end) + )) _); + [ clear parse_nonterminal Hsplits splits rdata cdata + | clear parse_nonterminal Hsplits splits rdata cdata + | .. + | admit ]. + abstract t_parse_production_for. + abstract t_parse_production_for. + abstract t_parse_production_for. + abstract t_parse_production_for. + Defined. diff --git a/test-suite/bugs/closed/bug_4462.v b/test-suite/bugs/closed/bug_4462.v new file mode 100644 index 0000000000..c680518c6a --- /dev/null +++ b/test-suite/bugs/closed/bug_4462.v @@ -0,0 +1,7 @@ +Variables P Q : Prop. +Axiom pqrw : P <-> Q. + +Require Setoid. + +Goal P -> Q. +unshelve (rewrite pqrw). diff --git a/test-suite/bugs/closed/bug_4464.v b/test-suite/bugs/closed/bug_4464.v new file mode 100644 index 0000000000..f8e9405d93 --- /dev/null +++ b/test-suite/bugs/closed/bug_4464.v @@ -0,0 +1,4 @@ +Goal True -> True. +Proof. + intro H'. + let H := H' in destruct H; try destruct H. diff --git a/test-suite/bugs/closed/bug_4467.v b/test-suite/bugs/closed/bug_4467.v new file mode 100644 index 0000000000..6f8631d458 --- /dev/null +++ b/test-suite/bugs/closed/bug_4467.v @@ -0,0 +1,15 @@ +(* Fixing missing test for variable shadowing *) + +Definition test (x y:bool*bool) := + match x with + | (e as e1, (true) as e2) + | ((true) as e1, e as e2) => + let '(e, b) := y in + e + | _ => true + end. + +Goal test (true,false) (true,true) = true. +(* used to evaluate to "false = true" in 8.4 *) +reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_4471.v b/test-suite/bugs/closed/bug_4471.v new file mode 100644 index 0000000000..36efc42d47 --- /dev/null +++ b/test-suite/bugs/closed/bug_4471.v @@ -0,0 +1,6 @@ +Goal forall (A B : Type) (P : forall _ : prod A B, Type) (a : A) (b : B) (p p0 : forall (x : A) (x' : B), P (@pair A B x x')), + @eq (P (@pair A B a b)) (p (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b))) + (p0 (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b))). +Proof. + intros. + Fail generalize dependent (a, b). diff --git a/test-suite/bugs/closed/bug_4479.v b/test-suite/bugs/closed/bug_4479.v new file mode 100644 index 0000000000..921579d1e1 --- /dev/null +++ b/test-suite/bugs/closed/bug_4479.v @@ -0,0 +1,3 @@ +Goal True. +Fail autorewrite with foo. +try autorewrite with foo. diff --git a/test-suite/bugs/closed/bug_4480.v b/test-suite/bugs/closed/bug_4480.v new file mode 100644 index 0000000000..ec6ec7e5c2 --- /dev/null +++ b/test-suite/bugs/closed/bug_4480.v @@ -0,0 +1,11 @@ +Require Import Setoid. + +Definition proj (P Q : Prop) := P. + +Lemma foo (P : Prop) : proj P P = P. +Admitted. +Lemma trueI : True <-> True. +Admitted. +Goal True. + Fail setoid_rewrite foo. + Fail setoid_rewrite trueI. diff --git a/test-suite/bugs/closed/bug_4484.v b/test-suite/bugs/closed/bug_4484.v new file mode 100644 index 0000000000..6231e2d3df --- /dev/null +++ b/test-suite/bugs/closed/bug_4484.v @@ -0,0 +1,10 @@ +(* Testing 8.5 regression with type classes not solving evars + redefined while trying to solve them with the type class mechanism *) + +Class A := {}. +Axiom foo : forall {ac : A}, bool. +Lemma bar (ac : A) : True. +Check (match foo as k return foo = k -> True with + | true => _ + | false => _ + end eq_refl). diff --git a/test-suite/bugs/closed/bug_4495.v b/test-suite/bugs/closed/bug_4495.v new file mode 100644 index 0000000000..8b032db5f5 --- /dev/null +++ b/test-suite/bugs/closed/bug_4495.v @@ -0,0 +1 @@ +Fail Notation "'forall' x .. y ',' P " := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder). diff --git a/test-suite/bugs/closed/bug_4498.v b/test-suite/bugs/closed/bug_4498.v new file mode 100644 index 0000000000..379e46b3e3 --- /dev/null +++ b/test-suite/bugs/closed/bug_4498.v @@ -0,0 +1,24 @@ +Require Export Coq.Unicode.Utf8. +Require Export Coq.Classes.Morphisms. +Require Export Coq.Relations.Relation_Definitions. + +Set Universe Polymorphism. + +Reserved Notation "a ~> b" (at level 90, right associativity). + +Class Category := { + ob : Type; + uhom := Type : Type; + hom : ob → ob → uhom where "a ~> b" := (hom a b); + compose : ∀ {A B C}, (B ~> C) → (A ~> B) → (A ~> C); + equiv : ∀ {A B}, relation (A ~> B); + is_equiv : ∀ {A B}, @Equivalence (A ~> B) equiv; + comp_respects : ∀ {A B C}, + Proper (@equiv B C ==> @equiv A B ==> @equiv A C) (@compose A B C); +}. + +Require Export Coq.Setoids.Setoid. + +Add Parametric Morphism `{C : Category} {A B C} : (@compose _ A B C) with + signature equiv ==> equiv ==> equiv as compose_mor. +Proof. apply comp_respects. Qed. diff --git a/test-suite/bugs/closed/bug_4503.v b/test-suite/bugs/closed/bug_4503.v new file mode 100644 index 0000000000..5162f352df --- /dev/null +++ b/test-suite/bugs/closed/bug_4503.v @@ -0,0 +1,37 @@ +Require Coq.Classes.RelationClasses. + +Class PreOrder (A : Type) (r : A -> A -> Type) : Type := +{ refl : forall x, r x x }. + +(* FAILURE 1 *) + +Section foo. + Polymorphic Universes A. + Polymorphic Context {A : Type@{A}} {rA : A -> A -> Prop} {PO : PreOrder A rA}. + + Fail Definition foo := PO. +End foo. + + +Module ILogic. + +Set Universe Polymorphism. + +(* Logical connectives *) +Class ILogic@{L} (A : Type@{L}) : Type := mkILogic +{ + lentails: A -> A -> Prop; + lentailsPre:> RelationClasses.PreOrder lentails +}. + + +End ILogic. + +Set Printing Universes. + +(* There is stil a problem if the class is universe polymorphic *) +Section Embed_ILogic_Pre. + Polymorphic Universes A T. + Fail Context {A : Type@{A}} {ILA: ILogic.ILogic@{A} A}. + +End Embed_ILogic_Pre. diff --git a/test-suite/bugs/closed/bug_4511.v b/test-suite/bugs/closed/bug_4511.v new file mode 100644 index 0000000000..0027596e59 --- /dev/null +++ b/test-suite/bugs/closed/bug_4511.v @@ -0,0 +1,2 @@ +Goal True. +Fail evar I. diff --git a/test-suite/bugs/closed/bug_4519.v b/test-suite/bugs/closed/bug_4519.v new file mode 100644 index 0000000000..2c984cad1c --- /dev/null +++ b/test-suite/bugs/closed/bug_4519.v @@ -0,0 +1,21 @@ +Set Universe Polymorphism. +Section foo. + Universe i. + Context (foo : Type@{i}) (bar : Type@{i}). + Definition qux@{i} (baz : Type@{i}) := foo -> bar. +End foo. +Set Printing Universes. +Print qux. (* qux@{Top.42 Top.43} = +fun foo bar _ : Type@{Top.42} => foo -> bar + : Type@{Top.42} -> Type@{Top.42} -> Type@{Top.42} -> Type@{Top.42} +(* Top.42 Top.43 |= *) +(* This is wrong; the first two types are equal, but the last one is not *) + +qux is universe polymorphic +Argument scopes are [type_scope type_scope type_scope] + *) +Check qux nat nat nat : Set. +Check qux nat nat Set : Set. (* Error: +The term "qux@{Top.50 Top.51} ?T ?T0 Set" has type "Type@{Top.50}" while it is +expected to have type "Set" +(universe inconsistency: Cannot enforce Top.50 = Set because Set < Top.50). *) diff --git a/test-suite/bugs/closed/bug_4527.v b/test-suite/bugs/closed/bug_4527.v new file mode 100644 index 0000000000..8749680e8d --- /dev/null +++ b/test-suite/bugs/closed/bug_4527.v @@ -0,0 +1,270 @@ +(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_bad_univ_length_01") -*- *) +(* File reduced by coq-bug-finder from original input, then from 1199 lines to +430 lines, then from 444 lines to 430 lines, then from 964 lines to 255 lines, +then from 269 lines to 255 lines *) +(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml +4.01.0 + coqtop version 8.5 (January 2016) *) +Declare ML Module "ltac_plugin". +Inductive False := . +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Coq.Init.Datatypes. + +Import Coq.Init.Notations. + +Global Set Universe Polymorphism. + +Notation "A -> B" := (forall (_ : A), B) : type_scope. + +Inductive True : Type := + I : True. +Module Export Datatypes. + +Set Implicit Arguments. +Notation nat := Coq.Init.Datatypes.nat. +Notation O := Coq.Init.Datatypes.O. +Notation S := Coq.Init.Datatypes.S. +Notation two := (S (S O)). + +Record prod (A B : Type) := pair { fst : A ; snd : B }. + +Notation "x * y" := (prod x y) : type_scope. + +Open Scope nat_scope. + +End Datatypes. +Module Export Specif. + +Set Implicit Arguments. + +Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P +proj1_sig }. + +Notation sigT := sig (only parsing). + +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. + +Notation projT1 := proj1_sig (only parsing). +Notation projT2 := proj2_sig (only parsing). + +End Specif. +Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. + +Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in +Type@{i}. + +Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in + let ge := ((fun x => x) : Type1@{j} -> +Type@{i}) in Type@{i}. + +Notation idmap := (fun x => x). +Delimit Scope function_scope with function. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Open Scope fibration_scope. +Open Scope function_scope. + +Notation pr1 := projT1. +Notation pr2 := projT2. + +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left +associativity) : function_scope. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. + +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. + +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : +type_scope. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) +}. + +Arguments eisretr {A B}%type_scope f%function_scope {_} _. +Arguments eissect {A B}%type_scope f%function_scope {_} _. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : +function_scope. + +Inductive Unit : Type1 := + tt : Unit. + +Local Open Scope path_scope. + +Section EquivInverse. + + Context {A B : Type} (f : A -> B) {feq : IsEquiv f}. + + Theorem other_adj (b : B) : eissect f (f^-1 b) = ap f^-1 (eisretr f b). +admit. +Defined. + + Global Instance isequiv_inverse : IsEquiv f^-1 | 10000 + := BuildIsEquiv B A f^-1 f (eissect f) (eisretr f) other_adj. +End EquivInverse. + +Section Adjointify. + + Context {A B : Type} (f : A -> B) (g : B -> A). + Context (isretr : Sect g f) (issect : Sect f g). + + Let issect' := fun x => + ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. + + Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). +admit. +Defined. + + Definition isequiv_adjointify : IsEquiv f + := BuildIsEquiv A B f g isretr issect' is_adjoint'. + +End Adjointify. + + Definition ExtensionAlong {A B : Type} (f : A -> B) + (P : B -> Type) (d : forall x:A, P (f x)) + := { s : forall y:B, P y & forall x:A, s (f x) = d x }. + + Fixpoint ExtendableAlong@{i j k l} + (n : nat) {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := match n with + | O => Unit@{l} + | S n => (forall (g : forall a, C (f a)), + ExtensionAlong@{i j k l l} f C g) * + forall (h k : forall b, C b), + ExtendableAlong n f (fun b => h b = k b) + end. + + Definition ooExtendableAlong@{i j k l} + {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := forall n, ExtendableAlong@{i j k l} n f C. + +Module Type ReflectiveSubuniverses. + + Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. + + Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : +Type@{i}), + In@{u a i} O (O_reflector@{u a i} O T). + + Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : +Type@{i}), + T -> O_reflector@{u a i} O T. + + Parameter inO_equiv_inO@{u a i j k} : + forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) + (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), + + let gei := ((fun x => x) : Type@{i} -> Type@{k}) in + let gej := ((fun x => x) : Type@{j} -> Type@{k}) in + In@{u a j} O U. + + Parameter extendable_to_O@{u a i j k} + : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : +Type2le@{j a}} {Q_inO : In@{u a j} O Q}, + ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). + +End ReflectiveSubuniverses. + +Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). +Export Os. + +Existing Class In. + + Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. + +Arguments inO_equiv_inO {O} T {U} {_} f {_}. +Global Existing Instance O_inO. + +Section ORecursion. + Context {O : ReflectiveSubuniverse}. + + Definition O_indpaths {P Q : Type} {Q_inO : In O Q} + (g h : O P -> Q) (p : g o to O P == h o to O P) + : g == h + := (fst (snd (extendable_to_O O two) g h) p).1. + + Definition O_indpaths_beta {P Q : Type} {Q_inO : In O Q} + (g h : O P -> Q) (p : g o (to O P) == h o (to O P)) (x : P) + : O_indpaths g h p (to O P x) = p x + := (fst (snd (extendable_to_O O two) g h) p).2 x. + +End ORecursion. + +Section Reflective_Subuniverse. + Universes Ou Oa. + Context (O : ReflectiveSubuniverse@{Ou Oa}). + + Definition inO_isequiv_to_O (T:Type) + : IsEquiv (to O T) -> In O T + := fun _ => inO_equiv_inO (O T) (to O T)^-1. + + Definition inO_to_O_retract (T:Type) (mu : O T -> T) + : Sect (to O T) mu -> In O T. + Proof. + unfold Sect; intros H. + apply inO_isequiv_to_O. + apply isequiv_adjointify with (g:=mu). + - + refine (O_indpaths (to O T o mu) idmap _). + intros x; exact (ap (to O T) (H x)). + - + exact H. + Defined. + + Definition inO_paths@{i} (S : Type@{i}) {S_inO : In@{Ou Oa i} O S} (x y : +S) : In@{Ou Oa i} O (x=y). + Proof. + simple refine (inO_to_O_retract@{i} _ _ _); intro u. + - + assert (p : (fun _ : O (x=y) => x) == (fun _=> y)). + { + refine (O_indpaths _ _ _); simpl. + intro v; exact v. +} + exact (p u). + - + hnf. + rewrite O_indpaths_beta; reflexivity. + Qed. + Check inO_paths@{Type}. diff --git a/test-suite/bugs/closed/bug_4529.v b/test-suite/bugs/closed/bug_4529.v new file mode 100644 index 0000000000..b16d81bd7c --- /dev/null +++ b/test-suite/bugs/closed/bug_4529.v @@ -0,0 +1,44 @@ +(* File reduced by coq-bug-finder from original input, then from 1334 lines to 1518 lines, then from 849 lines to 59 lines *) +(* coqc version 8.5 (January 2016) compiled on Jan 22 2016 18:20:47 with OCaml 4.02.3 + coqtop version r-schnelltop:/home/r/src/coq/coq,(HEAD detached at V8.5) (5e23fb90b39dfa014ae5c4fb46eb713cca09dbff) *) +Require Coq.Setoids.Setoid. +Import Coq.Setoids.Setoid. + +Class Equiv A := equiv: relation A. +Infix "≡" := equiv (at level 70, no associativity). +Notation "(≡)" := equiv (only parsing). + +(* If I remove this line, everything compiles. *) +Set Primitive Projections. + +Class Dist A := dist : nat -> relation A. +Notation "x ={ n }= y" := (dist n x y) + (at level 70, n at next level, format "x ={ n }= y"). + +Record CofeMixin A `{Equiv A, Dist A} := { + mixin_equiv_dist x y : x ≡ y <-> forall n, x ={n}= y; + mixin_dist_equivalence n : Equivalence (dist n); +}. + +Structure cofeT := CofeT { + cofe_car :> Type; + cofe_equiv : Equiv cofe_car; + cofe_dist : Dist cofe_car; + cofe_mixin : CofeMixin cofe_car +}. +Existing Instances cofe_equiv cofe_dist. +Arguments cofe_car : simpl never. + +Section cofe_mixin. + Context {A : cofeT}. + Implicit Types x y : A. + Lemma equiv_dist x y : x ≡ y <-> forall n, x ={n}= y. +Admitted. +End cofe_mixin. + Context {A : cofeT}. + Global Instance cofe_equivalence : Equivalence ((≡) : relation A). + Proof. + split. + * + intros x. +apply equiv_dist. diff --git a/test-suite/bugs/closed/bug_4533.v b/test-suite/bugs/closed/bug_4533.v new file mode 100644 index 0000000000..f9cccd5a56 --- /dev/null +++ b/test-suite/bugs/closed/bug_4533.v @@ -0,0 +1,230 @@ +(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_lex_wrong_rewrite_02") -*- *) +(* File reduced by coq-bug-finder from original input, then from 1125 lines to +346 lines, then from 360 lines to 346 lines, then from 822 lines to 271 lines, +then from 285 lines to 271 lines *) +(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml +4.01.0 + coqtop version 8.5 (January 2016) *) +Declare ML Module "ltac_plugin". +Inductive False := . +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Coq.Init.Datatypes. +Import Coq.Init.Notations. +Global Set Universe Polymorphism. +Global Set Primitive Projections. +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Module Export Datatypes. + Set Implicit Arguments. + Notation nat := Coq.Init.Datatypes.nat. + Notation O := Coq.Init.Datatypes.O. + Notation S := Coq.Init.Datatypes.S. + Notation one := (S O). + Notation two := (S one). + Record prod (A B : Type) := pair { fst : A ; snd : B }. + Notation "x * y" := (prod x y) : type_scope. + Delimit Scope nat_scope with nat. + Open Scope nat_scope. +End Datatypes. +Module Export Specif. + Set Implicit Arguments. + Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P +proj1_sig }. + Notation sigT := sig (only parsing). + Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. + Notation projT1 := proj1_sig (only parsing). + Notation projT2 := proj2_sig (only parsing). +End Specif. +Global Set Keyed Unification. +Global Unset Strict Universe Declaration. +Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. +Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in +Type@{i}. +Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in + let ge := ((fun x => x) : Type1@{j} -> +Type@{i}) in Type@{i}. +Notation idmap := (fun x => x). +Delimit Scope function_scope with function. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Open Scope fibration_scope. +Open Scope function_scope. +Notation pr1 := projT1. +Notation pr2 := projT2. +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. +Notation compose := (fun g f x => g (f x)). +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left +associativity) : function_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. +Notation "1" := idpath : path_scope. +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : +type_scope. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr +(f x) = ap f (eissect x) + }. +Arguments eissect {A B}%type_scope f%function_scope {_} _. +Inductive Unit : Type1 := tt : Unit. +Local Open Scope path_scope. +Definition concat_p_pp {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z += t) : + p @ (q @ r) = (p @ q) @ r := + match r with idpath => + match q with idpath => + match p with idpath => 1 + end end end. +Section Adjointify. + Context {A B : Type} (f : A -> B) (g : B -> A). + Context (isretr : Sect g f) (issect : Sect f g). + Let issect' := fun x => + ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. + + Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). + admit. + Defined. + + Definition isequiv_adjointify : IsEquiv f + := BuildIsEquiv A B f g isretr issect' is_adjoint'. +End Adjointify. +Definition ExtensionAlong {A B : Type} (f : A -> B) + (P : B -> Type) (d : forall x:A, P (f x)) + := { s : forall y:B, P y & forall x:A, s (f x) = d x }. +Fixpoint ExtendableAlong@{i j k l} + (n : nat) {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := match n with + | O => Unit@{l} + | S n => (forall (g : forall a, C (f a)), + ExtensionAlong@{i j k l l} f C g) * + forall (h k : forall b, C b), + ExtendableAlong n f (fun b => h b = k b) + end. + +Definition ooExtendableAlong@{i j k l} + {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := forall n, ExtendableAlong@{i j k l} n f C. + +Module Type ReflectiveSubuniverses. + + Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. + + Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : +Type@{i}), + In@{u a i} O (O_reflector@{u a i} O T). + + Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : +Type@{i}), + T -> O_reflector@{u a i} O T. + + Parameter extendable_to_O@{u a i j k} + : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : +Type2le@{j a}} {Q_inO : In@{u a j} O Q}, + ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). + +End ReflectiveSubuniverses. + +Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). + Export Os. + Existing Class In. + Module Export Coercions. + Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. + End Coercions. + Global Existing Instance O_inO. + + Section ORecursion. + Context {O : ReflectiveSubuniverse}. + + Definition O_rec {P Q : Type} {Q_inO : In O Q} + (f : P -> Q) + : O P -> Q + := (fst (extendable_to_O O one) f).1. + + Definition O_rec_beta {P Q : Type} {Q_inO : In O Q} + (f : P -> Q) (x : P) + : O_rec f (to O P x) = f x + := (fst (extendable_to_O O one) f).2 x. + + Definition O_indpaths {P Q : Type} {Q_inO : In O Q} + (g h : O P -> Q) (p : g o to O P == h o to O P) + : g == h + := (fst (snd (extendable_to_O O two) g h) p).1. + + End ORecursion. + + + Section Reflective_Subuniverse. + Context (O : ReflectiveSubuniverse@{Ou Oa}). + + Definition isequiv_to_O_inO@{u a i} (T : Type@{i}) `{In@{u a i} O T} : +IsEquiv@{i i} (to O T). + Proof. + + pose (g := O_rec@{u a i i i i i} idmap). + refine (isequiv_adjointify (to O T) g _ _). + - + refine (O_indpaths@{u a i i i i i} (to O T o g) idmap _). + intros x. + apply ap. + apply O_rec_beta. + - + intros x. + apply O_rec_beta. + Defined. + Global Existing Instance isequiv_to_O_inO. + + End Reflective_Subuniverse. + +End ReflectiveSubuniverses_Theory. + +Module Type Preserves_Fibers (Os : ReflectiveSubuniverses). + Module Export Os_Theory := ReflectiveSubuniverses_Theory Os. +End Preserves_Fibers. + +Opaque eissect. +Module Lex_Reflective_Subuniverses + (Os : ReflectiveSubuniverses) (Opf : Preserves_Fibers Os). + Import Opf. + Goal forall (O : ReflectiveSubuniverse) (A : Type) (B : A -> Type) (A_inO : +In O A), + + forall g, + forall (x : O {x : A & B x}) v v' v'' (p2 : v'' = v') (p0 : v' = v) (p1 : +v = _) r, + (p2 + @ (p0 + @ p1)) + @ eissect (to O A) (g x) = r. + intros. + cbv zeta. + rewrite concat_p_pp. + match goal with + | [ |- p2 @ p0 @ p1 @ eissect (to O A) (g x) = r ] => idtac "good" + | [ |- ?G ] => fail 1 "bad" G + end. + Fail rewrite concat_p_pp. diff --git a/test-suite/bugs/closed/bug_4538.v b/test-suite/bugs/closed/bug_4538.v new file mode 100644 index 0000000000..f925aae9e5 --- /dev/null +++ b/test-suite/bugs/closed/bug_4538.v @@ -0,0 +1 @@ +Reserved Notation " (u *) ". diff --git a/test-suite/bugs/closed/bug_4544.v b/test-suite/bugs/closed/bug_4544.v new file mode 100644 index 0000000000..13c47edc8f --- /dev/null +++ b/test-suite/bugs/closed/bug_4544.v @@ -0,0 +1,1009 @@ +(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_oog_looping_rewrite_01") -*- *) +(* File reduced by coq-bug-finder from original input, then from 2553 lines to 1932 lines, then from 1946 lines to 1932 lines, then from 2467 lines to 1002 lines, then from 1016 lines to 1002 lines *) +(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml 4.01.0 + coqtop version 8.5 (January 2016) *) +Declare ML Module "ltac_plugin". +Inductive False := . +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Coq.Init.Datatypes. + +Import Coq.Init.Notations. + +Global Set Universe Polymorphism. + +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Global Set Primitive Projections. + +Inductive sum (A B : Type) : Type := + | inl : A -> sum A B + | inr : B -> sum A B. +Notation nat := Coq.Init.Datatypes.nat. +Notation O := Coq.Init.Datatypes.O. +Notation S := Coq.Init.Datatypes.S. +Notation "x + y" := (sum x y) : type_scope. + +Record prod (A B : Type) := pair { fst : A ; snd : B }. + +Notation "x * y" := (prod x y) : type_scope. +Module Export Specif. + +Set Implicit Arguments. + +Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. +Arguments proj1_sig {A P} _ / . + +Notation sigT := sig (only parsing). +Notation existT := exist (only parsing). + +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. + +Notation projT1 := proj1_sig (only parsing). +Notation projT2 := proj2_sig (only parsing). + +End Specif. +Module Export HoTT_DOT_Basics_DOT_Overture. +Module Export HoTT. +Module Export Basics. +Module Export Overture. + +Global Set Keyed Unification. + +Global Unset Strict Universe Declaration. + +Notation Type0 := Set. + +Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. + +Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in Type@{i}. + +Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in + let ge := ((fun x => x) : Type1@{j} -> Type@{i}) in Type@{i}. + +Notation idmap := (fun x => x). +Delimit Scope function_scope with function. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Delimit Scope trunc_scope with trunc. + +Open Scope trunc_scope. +Open Scope path_scope. +Open Scope fibration_scope. +Open Scope nat_scope. +Open Scope function_scope. + +Notation "( x ; y )" := (existT _ x y) : fibration_scope. + +Notation pr1 := projT1. +Notation pr2 := projT2. + +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Notation "1" := idpath : path_scope. + +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. + +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. + +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. + +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) +}. + +Arguments eisretr {A B}%type_scope f%function_scope {_} _. + +Record Equiv A B := BuildEquiv { + equiv_fun : A -> B ; + equiv_isequiv : IsEquiv equiv_fun +}. + +Coercion equiv_fun : Equiv >-> Funclass. + +Global Existing Instance equiv_isequiv. + +Notation "A <~> B" := (Equiv A B) (at level 85) : type_scope. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) +}. + +Arguments center A {_}. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. +Notation "-2" := minus_two (at level 0) : trunc_scope. +Notation "-1" := (-2.+1) (at level 0) : trunc_scope. +Notation "0" := (-1.+1) : trunc_scope. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | -2 => Contr_internal A + | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Global Instance istrunc_paths (A : Type) n `{H : IsTrunc n.+1 A} (x y : A) +: IsTrunc n (x = y) + := H x y. + +Notation Contr := (IsTrunc -2). +Notation IsHProp := (IsTrunc -1). + +Hint Extern 0 => progress change Contr_internal with Contr in * : typeclass_instances. + +Monomorphic Axiom dummy_funext_type : Type0. +Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. + +Inductive Unit : Type1 := + tt : Unit. + +Class IsPointed (A : Type) := point : A. + +Arguments point A {_}. + +Record pType := + { pointed_type : Type ; + ispointed_type : IsPointed pointed_type }. + +Coercion pointed_type : pType >-> Sortclass. + +Global Existing Instance ispointed_type. + +Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. + +Ltac revert_opaque x := + revert x; + match goal with + | [ |- forall _, _ ] => idtac + | _ => fail 1 "Reverted constant is not an opaque variable" + end. + +End Overture. + +End Basics. + +End HoTT. + +End HoTT_DOT_Basics_DOT_Overture. +Module Export HoTT_DOT_Basics_DOT_PathGroupoids. +Module Export HoTT. +Module Export Basics. +Module Export PathGroupoids. + +Local Open Scope path_scope. + +Definition concat_p1 {A : Type} {x y : A} (p : x = y) : + p @ 1 = p + := + match p with idpath => 1 end. + +Definition concat_1p {A : Type} {x y : A} (p : x = y) : + 1 @ p = p + := + match p with idpath => 1 end. + +Definition concat_p_pp {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z = t) : + p @ (q @ r) = (p @ q) @ r := + match r with idpath => + match q with idpath => + match p with idpath => 1 + end end end. + +Definition concat_pp_p {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z = t) : + (p @ q) @ r = p @ (q @ r) := + match r with idpath => + match q with idpath => + match p with idpath => 1 + end end end. + +Definition concat_pV {A : Type} {x y : A} (p : x = y) : + p @ p^ = 1 + := + match p with idpath => 1 end. + +Definition moveR_Vp {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : x = y) : + p = r @ q -> r^ @ p = q. +admit. +Defined. + +Definition moveL_Vp {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : x = y) : + r @ q = p -> q = r^ @ p. +admit. +Defined. + +Definition moveR_M1 {A : Type} {x y : A} (p q : x = y) : + 1 = p^ @ q -> p = q. +admit. +Defined. + +Definition ap_pp {A B : Type} (f : A -> B) {x y z : A} (p : x = y) (q : y = z) : + ap f (p @ q) = (ap f p) @ (ap f q) + := + match q with + idpath => + match p with idpath => 1 end + end. + +Definition ap_V {A B : Type} (f : A -> B) {x y : A} (p : x = y) : + ap f (p^) = (ap f p)^ + := + match p with idpath => 1 end. + +Definition ap_compose {A B C : Type} (f : A -> B) (g : B -> C) {x y : A} (p : x = y) : + ap (g o f) p = ap g (ap f p) + := + match p with idpath => 1 end. + +Definition concat_pA1 {A : Type} {f : A -> A} (p : forall x, x = f x) {x y : A} (q : x = y) : + (p x) @ (ap f q) = q @ (p y) + := + match q as i in (_ = y) return (p x @ ap f i = i @ p y) with + | idpath => concat_p1 _ @ (concat_1p _)^ + end. + +End PathGroupoids. + +End Basics. + +End HoTT. + +End HoTT_DOT_Basics_DOT_PathGroupoids. +Module Export HoTT_DOT_Basics_DOT_Equivalences. +Module Export HoTT. +Module Export Basics. +Module Export Equivalences. + +Definition isequiv_commsq {A B C D} + (f : A -> B) (g : C -> D) (h : A -> C) (k : B -> D) + (p : k o f == g o h) + `{IsEquiv _ _ f} `{IsEquiv _ _ h} `{IsEquiv _ _ k} +: IsEquiv g. +admit. +Defined. + +Section Adjointify. + + Context {A B : Type} (f : A -> B) (g : B -> A). + Context (isretr : Sect g f) (issect : Sect f g). + + Let issect' := fun x => + ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. + + Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). + Proof. + unfold issect'. + apply moveR_M1. + repeat rewrite ap_pp, concat_p_pp; rewrite <- ap_compose. + rewrite (concat_pA1 (fun b => (isretr b)^) (ap f (issect a)^)). + repeat rewrite concat_pp_p; rewrite ap_V; apply moveL_Vp; rewrite concat_p1. + rewrite concat_p_pp, <- ap_compose. + rewrite (concat_pA1 (fun b => (isretr b)^) (isretr (f a))). + rewrite concat_pV, concat_1p; reflexivity. + Qed. + + Definition isequiv_adjointify : IsEquiv f + := BuildIsEquiv A B f g isretr issect' is_adjoint'. + +End Adjointify. + +End Equivalences. + +End Basics. + +End HoTT. + +End HoTT_DOT_Basics_DOT_Equivalences. +Module Export HoTT_DOT_Basics_DOT_Trunc. +Module Export HoTT. +Module Export Basics. +Module Export Trunc. +Generalizable Variables A B m n f. + +Definition trunc_equiv A {B} (f : A -> B) + `{IsTrunc n A} `{IsEquiv A B f} + : IsTrunc n B. +admit. +Defined. + +Record TruncType (n : trunc_index) := BuildTruncType { + trunctype_type : Type ; + istrunc_trunctype_type : IsTrunc n trunctype_type +}. + +Arguments BuildTruncType _ _ {_}. + +Coercion trunctype_type : TruncType >-> Sortclass. + +Notation "n -Type" := (TruncType n) (at level 1) : type_scope. +Notation hProp := (-1)-Type. + +Notation BuildhProp := (BuildTruncType -1). + +End Trunc. + +End Basics. + +End HoTT. + +End HoTT_DOT_Basics_DOT_Trunc. +Module Export HoTT_DOT_Types_DOT_Unit. +Module Export HoTT. +Module Export Types. +Module Export Unit. + +Notation unit_name x := (fun (_ : Unit) => x). + +End Unit. + +End Types. + +End HoTT. + +End HoTT_DOT_Types_DOT_Unit. +Module Export HoTT_DOT_Types_DOT_Sigma. +Module Export HoTT. +Module Export Types. +Module Export Sigma. +Local Open Scope path_scope. + +Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (pq : {p : u.1 = v.1 & p # u.2 = v.2}) +: u = v + := match pq.2 in (_ = v2) return u = (v.1; v2) with + | 1 => match pq.1 as p in (_ = v1) return u = (v1; p # u.2) with + | 1 => 1 + end + end. + +Definition path_sigma {A : Type} (P : A -> Type) (u v : sigT P) + (p : u.1 = v.1) (q : p # u.2 = v.2) +: u = v + := path_sigma_uncurried P u v (p;q). + +Definition path_sigma' {A : Type} (P : A -> Type) {x x' : A} {y : P x} {y' : P x'} + (p : x = x') (q : p # y = y') +: (x;y) = (x';y') + := path_sigma P (x;y) (x';y') p q. + +Global Instance isequiv_pr1_contr {A} {P : A -> Type} + `{forall a, Contr (P a)} +: IsEquiv (@pr1 A P) | 100. +Proof. + refine (isequiv_adjointify (@pr1 A P) + (fun a => (a ; center (P a))) _ _). + - + intros a; reflexivity. + - + intros [a p]. + refine (path_sigma' P 1 (contr _)). +Defined. + +Definition path_sigma_hprop {A : Type} {P : A -> Type} + `{forall x, IsHProp (P x)} + (u v : sigT P) +: u.1 = v.1 -> u = v + := path_sigma_uncurried P u v o pr1^-1. + +End Sigma. + +End Types. + +End HoTT. + +End HoTT_DOT_Types_DOT_Sigma. +Module Export HoTT_DOT_Extensions. +Module Export HoTT. +Module Export Extensions. + +Section Extensions. + + Definition ExtensionAlong {A B : Type} (f : A -> B) + (P : B -> Type) (d : forall x:A, P (f x)) + := { s : forall y:B, P y & forall x:A, s (f x) = d x }. + + Fixpoint ExtendableAlong@{i j k l} + (n : nat) {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := match n with + | O => Unit@{l} + | S n => (forall (g : forall a, C (f a)), + ExtensionAlong@{i j k l l} f C g) * + forall (h k : forall b, C b), + ExtendableAlong n f (fun b => h b = k b) + end. + + Definition ooExtendableAlong@{i j k l} + {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := forall n, ExtendableAlong@{i j k l} n f C. + +End Extensions. + +End Extensions. + +End HoTT. + +End HoTT_DOT_Extensions. +Module Export HoTT. +Module Export Modalities. +Module Export ReflectiveSubuniverse. + +Module Type ReflectiveSubuniverses. + + Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. + + Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), + In@{u a i} O (O_reflector@{u a i} O T). + + Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), + T -> O_reflector@{u a i} O T. + + Parameter inO_equiv_inO@{u a i j k} : + forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) + (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), + + let gei := ((fun x => x) : Type@{i} -> Type@{k}) in + let gej := ((fun x => x) : Type@{j} -> Type@{k}) in + In@{u a j} O U. + + Parameter hprop_inO@{u a i} + : Funext -> forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), + IsHProp (In@{u a i} O T). + + Parameter extendable_to_O@{u a i j k} + : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : Type2le@{j a}} {Q_inO : In@{u a j} O Q}, + ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). + +End ReflectiveSubuniverses. + +Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). +Export Os. + +Module Export Coercions. + + Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. + +End Coercions. + +End ReflectiveSubuniverses_Theory. + +Module Type ReflectiveSubuniverses_Restriction_Data (Os : ReflectiveSubuniverses). + + Parameter New_ReflectiveSubuniverse@{u a} : Type2@{u a}. + + Parameter ReflectiveSubuniverses_restriction@{u a} + : New_ReflectiveSubuniverse@{u a} -> Os.ReflectiveSubuniverse@{u a}. + +End ReflectiveSubuniverses_Restriction_Data. + +Module ReflectiveSubuniverses_Restriction + (Os : ReflectiveSubuniverses) + (Res : ReflectiveSubuniverses_Restriction_Data Os) +<: ReflectiveSubuniverses. + + Definition ReflectiveSubuniverse := Res.New_ReflectiveSubuniverse. + + Definition O_reflector@{u a i} (O : ReflectiveSubuniverse@{u a}) + := Os.O_reflector@{u a i} (Res.ReflectiveSubuniverses_restriction O). + Definition In@{u a i} (O : ReflectiveSubuniverse@{u a}) + := Os.In@{u a i} (Res.ReflectiveSubuniverses_restriction O). + Definition O_inO@{u a i} (O : ReflectiveSubuniverse@{u a}) + := Os.O_inO@{u a i} (Res.ReflectiveSubuniverses_restriction O). + Definition to@{u a i} (O : ReflectiveSubuniverse@{u a}) + := Os.to@{u a i} (Res.ReflectiveSubuniverses_restriction O). + Definition inO_equiv_inO@{u a i j k} (O : ReflectiveSubuniverse@{u a}) + := Os.inO_equiv_inO@{u a i j k} (Res.ReflectiveSubuniverses_restriction O). + Definition hprop_inO@{u a i} (H : Funext) (O : ReflectiveSubuniverse@{u a}) + := Os.hprop_inO@{u a i} H (Res.ReflectiveSubuniverses_restriction O). + Definition extendable_to_O@{u a i j k} (O : ReflectiveSubuniverse@{u a}) + := @Os.extendable_to_O@{u a i j k} (Res.ReflectiveSubuniverses_restriction@{u a} O). + +End ReflectiveSubuniverses_Restriction. + +Module ReflectiveSubuniverses_FamUnion + (Os1 Os2 : ReflectiveSubuniverses) +<: ReflectiveSubuniverses. + + Definition ReflectiveSubuniverse@{u a} : Type2@{u a} + := Os1.ReflectiveSubuniverse@{u a} + Os2.ReflectiveSubuniverse@{u a}. + + Definition O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. +admit. +Defined. + + Definition In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + Proof. + intros [O|O]; [ exact (Os1.In@{u a i} O) + | exact (Os2.In@{u a i} O) ]. + Defined. + + Definition O_inO@{u a i} + : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), + In@{u a i} O (O_reflector@{u a i} O T). +admit. +Defined. + + Definition to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), + T -> O_reflector@{u a i} O T. +admit. +Defined. + + Definition inO_equiv_inO@{u a i j k} : + forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) + (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), + In@{u a j} O U. + Proof. + intros [O|O]; [ exact (Os1.inO_equiv_inO@{u a i j k} O) + | exact (Os2.inO_equiv_inO@{u a i j k} O) ]. + Defined. + + Definition hprop_inO@{u a i} + : Funext -> forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), + IsHProp (In@{u a i} O T). +admit. +Defined. + + Definition extendable_to_O@{u a i j k} + : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : Type2le@{j a}} {Q_inO : In@{u a j} O Q}, + ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). +admit. +Defined. + +End ReflectiveSubuniverses_FamUnion. + +End ReflectiveSubuniverse. + +End Modalities. + +End HoTT. + +Module Type Modalities. + + Parameter Modality@{u a} : Type2@{u a}. + + Parameter O_reflector@{u a i} : forall (O : Modality@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter In@{u a i} : forall (O : Modality@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter O_inO@{u a i} : forall (O : Modality@{u a}) (T : Type@{i}), + In@{u a i} O (O_reflector@{u a i} O T). + + Parameter to@{u a i} : forall (O : Modality@{u a}) (T : Type@{i}), + T -> O_reflector@{u a i} O T. + + Parameter inO_equiv_inO@{u a i j k} : + forall (O : Modality@{u a}) (T : Type@{i}) (U : Type@{j}) + (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), + + let gei := ((fun x => x) : Type@{i} -> Type@{k}) in + let gej := ((fun x => x) : Type@{j} -> Type@{k}) in + In@{u a j} O U. + + Parameter hprop_inO@{u a i} + : Funext -> forall (O : Modality@{u a}) (T : Type@{i}), + IsHProp (In@{u a i} O T). + +End Modalities. + +Module Modalities_to_ReflectiveSubuniverses + (Os : Modalities) <: ReflectiveSubuniverses. + + Import Os. + + Fixpoint O_extendable@{u a i j k} (O : Modality@{u a}) + (A : Type@{i}) (B : O_reflector O A -> Type@{j}) + (B_inO : forall a, In@{u a j} O (B a)) (n : nat) + : ExtendableAlong@{i i j k} n (to O A) B. +admit. +Defined. + + Definition ReflectiveSubuniverse := Modality. + + Definition O_reflector@{u a i} := O_reflector@{u a i}. + + Definition In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a} + := In@{u a i}. + Definition O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), + In@{u a i} O (O_reflector@{u a i} O T) + := O_inO@{u a i}. + Definition to@{u a i} := to@{u a i}. + Definition inO_equiv_inO@{u a i j k} : + forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) + (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), + In@{u a j} O U + := inO_equiv_inO@{u a i j k}. + Definition hprop_inO@{u a i} + : Funext -> forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}), + IsHProp (In@{u a i} O T) + := hprop_inO@{u a i}. + + Definition extendable_to_O@{u a i j k} (O : ReflectiveSubuniverse@{u a}) + {P : Type2le@{i a}} {Q : Type2le@{j a}} {Q_inO : In@{u a j} O Q} + : ooExtendableAlong@{i i j k} (to O P) (fun _ => Q) + := fun n => O_extendable O P (fun _ => Q) (fun _ => Q_inO) n. + +End Modalities_to_ReflectiveSubuniverses. + +Module Type EasyModalities. + + Parameter Modality@{u a} : Type2@{u a}. + + Parameter O_reflector@{u a i} : forall (O : Modality@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter to@{u a i} : forall (O : Modality@{u a}) (T : Type@{i}), + T -> O_reflector@{u a i} O T. + + Parameter minO_pathsO@{u a i} + : forall (O : Modality@{u a}) (A : Type@{i}) + (z z' : O_reflector@{u a i} O A), + IsEquiv (to@{u a i} O (z = z')). + +End EasyModalities. + +Module EasyModalities_to_Modalities (Os : EasyModalities) +<: Modalities. + + Import Os. + + Definition Modality := Modality. + + Definition O_reflector@{u a i} := O_reflector@{u a i}. + Definition to@{u a i} := to@{u a i}. + + Definition In@{u a i} + : forall (O : Modality@{u a}), Type@{i} -> Type@{i} + := fun O A => IsEquiv@{i i} (to O A). + + Definition hprop_inO@{u a i} `{Funext} (O : Modality@{u a}) + (T : Type@{i}) + : IsHProp (In@{u a i} O T). +admit. +Defined. + + Definition O_ind_internal@{u a i j k} (O : Modality@{u a}) + (A : Type@{i}) (B : O_reflector@{u a i} O A -> Type@{j}) + (B_inO : forall oa, In@{u a j} O (B oa)) + : let gei := ((fun x => x) : Type@{i} -> Type@{k}) in + let gej := ((fun x => x) : Type@{j} -> Type@{k}) in + (forall a, B (to O A a)) -> forall oa, B oa. +admit. +Defined. + + Definition O_ind_beta_internal@{u a i j k} (O : Modality@{u a}) + (A : Type@{i}) (B : O_reflector@{u a i} O A -> Type@{j}) + (B_inO : forall oa, In@{u a j} O (B oa)) + (f : forall a : A, B (to O A a)) (a:A) + : O_ind_internal@{u a i j k} O A B B_inO f (to O A a) = f a. +admit. +Defined. + + Definition O_inO@{u a i} (O : Modality@{u a}) (A : Type@{i}) + : In@{u a i} O (O_reflector@{u a i} O A). +admit. +Defined. + + Definition inO_equiv_inO@{u a i j k} (O : Modality@{u a}) (A : Type@{i}) (B : Type@{j}) + (A_inO : In@{u a i} O A) (f : A -> B) (feq : IsEquiv f) + : In@{u a j} O B. + Proof. + simple refine (isequiv_commsq (to O A) (to O B) f + (O_ind_internal O A (fun _ => O_reflector O B) _ (fun a => to O B (f a))) _). + - + intros; apply O_inO. + - + intros a; refine (O_ind_beta_internal@{u a i j k} O A (fun _ => O_reflector O B) _ _ a). + - + apply A_inO. + - + simple refine (isequiv_adjointify _ + (O_ind_internal O B (fun _ => O_reflector O A) _ (fun b => to O A (f^-1 b))) _ _); + intros x. + + + apply O_inO. + + + pattern x; refine (O_ind_internal O B _ _ _ x); intros. + * + apply minO_pathsO. + * + simpl; admit. + + + pattern x; refine (O_ind_internal O A _ _ _ x); intros. + * + apply minO_pathsO. + * + simpl; admit. + Defined. + +End EasyModalities_to_Modalities. + +Module Modalities_Theory (Os : Modalities). + +Export Os. +Module Export Os_ReflectiveSubuniverses + := Modalities_to_ReflectiveSubuniverses Os. +Module Export RSU + := ReflectiveSubuniverses_Theory Os_ReflectiveSubuniverses. + +Module Export Coercions. + Coercion modality_to_reflective_subuniverse + := idmap : Modality -> ReflectiveSubuniverse. +End Coercions. + +Class IsConnected (O : Modality@{u a}) (A : Type@{i}) + + := isconnected_contr_O : IsTrunc@{i} -2 (O A). + +Class IsConnMap (O : Modality@{u a}) + {A : Type@{i}} {B : Type@{j}} (f : A -> B) + := isconnected_hfiber_conn_map + + : forall b:B, IsConnected@{u a k} O (hfiber@{i j} f b). + +End Modalities_Theory. + +Private Inductive Trunc (n : trunc_index) (A :Type) : Type := + tr : A -> Trunc n A. +Arguments tr {n A} a. + +Global Instance istrunc_truncation (n : trunc_index) (A : Type@{i}) +: IsTrunc@{j} n (Trunc@{i} n A). +Admitted. + +Definition Trunc_ind {n A} + (P : Trunc n A -> Type) {Pt : forall aa, IsTrunc n (P aa)} + : (forall a, P (tr a)) -> (forall aa, P aa) +:= (fun f aa => match aa with tr a => fun _ => f a end Pt). + +Definition Truncation_Modality := trunc_index. + +Module Truncation_Modalities <: Modalities. + + Definition Modality : Type2@{u a} := Truncation_Modality. + + Definition O_reflector (n : Modality@{u u'}) A := Trunc n A. + + Definition In (n : Modality@{u u'}) A := IsTrunc n A. + + Definition O_inO (n : Modality@{u u'}) A : In n (O_reflector n A). +admit. +Defined. + + Definition to (n : Modality@{u u'}) A := @tr n A. + + Definition inO_equiv_inO (n : Modality@{u u'}) + (A : Type@{i}) (B : Type@{j}) Atr f feq + : let gei := ((fun x => x) : Type@{i} -> Type@{k}) in + let gej := ((fun x => x) : Type@{j} -> Type@{k}) in + In n B + := @trunc_equiv A B f n Atr feq. + + Definition hprop_inO `{Funext} (n : Modality@{u u'}) A + : IsHProp (In n A). +admit. +Defined. + +End Truncation_Modalities. + +Module Import TrM := Modalities_Theory Truncation_Modalities. + +Definition merely (A : Type@{i}) : hProp := BuildhProp (Trunc -1 A). + +Notation IsSurjection := (IsConnMap -1). + +Definition BuildIsSurjection {A B} (f : A -> B) : + (forall b, merely (hfiber f b)) -> IsSurjection f. +admit. +Defined. + +Ltac strip_truncations := + + progress repeat match goal with + | [ T : _ |- _ ] + => revert_opaque T; + refine (@Trunc_ind _ _ _ _ _); + + []; + intro T + end. +Local Open Scope trunc_scope. + +Global Instance conn_pointed_type {n : trunc_index} {A : Type} (a0:A) + `{IsConnMap n _ _ (unit_name a0)} : IsConnected n.+1 A | 1000. +admit. +Defined. + +Definition loops (A : pType) : pType := + Build_pType (point A = point A) idpath. + +Record pMap (A B : pType) := + { pointed_fun : A -> B ; + point_eq : pointed_fun (point A) = point B }. + +Arguments point_eq {A B} f : rename. +Coercion pointed_fun : pMap >-> Funclass. + +Infix "->*" := pMap (at level 99) : pointed_scope. +Local Open Scope pointed_scope. + +Definition pmap_compose {A B C : pType} + (g : B ->* C) (f : A ->* B) +: A ->* C + := Build_pMap A C (g o f) + (ap g (point_eq f) @ point_eq g). + +Record pHomotopy {A B : pType} (f g : pMap A B) := + { pointed_htpy : f == g ; + point_htpy : pointed_htpy (point A) @ point_eq g = point_eq f }. +Arguments pointed_htpy {A B f g} p x. + +Infix "==*" := pHomotopy (at level 70, no associativity) : pointed_scope. + +Definition loops_functor {A B : pType} (f : A ->* B) +: (loops A) ->* (loops B). +Proof. + refine (Build_pMap (loops A) (loops B) + (fun p => (point_eq f)^ @ (ap f p @ point_eq f)) _). + apply moveR_Vp; simpl. + refine (concat_1p _ @ (concat_p1 _)^). +Defined. + +Definition loops_functor_compose {A B C : pType} + (g : B ->* C) (f : A ->* B) +: (loops_functor (pmap_compose g f)) + ==* (pmap_compose (loops_functor g) (loops_functor f)). +admit. +Defined. + +Local Open Scope path_scope. + +Record ooGroup := + { classifying_space : pType@{i} ; + isconn_classifying_space : IsConnected@{u a i} 0 classifying_space + }. + +Local Notation B := classifying_space. + +Definition group_type (G : ooGroup) : Type + := point (B G) = point (B G). + +Coercion group_type : ooGroup >-> Sortclass. + +Definition group_loops (X : pType) +: ooGroup. +Proof. + + pose (x0 := point X); + pose (BG := (Build_pType + { x:X & merely (x = point X) } + (existT (fun x:X => merely (x = point X)) x0 (tr 1)))). + + cut (IsConnected 0 BG). + { + exact (Build_ooGroup BG). +} + cut (IsSurjection (unit_name (point BG))). + { + intros; refine (conn_pointed_type (point _)). +} + apply BuildIsSurjection; simpl; intros [x p]. + strip_truncations; apply tr; exists tt. + apply path_sigma_hprop; simpl. + exact (p^). +Defined. + +Definition loops_group (X : pType) +: loops X <~> group_loops X. +admit. +Defined. + +Definition ooGroupHom (G H : ooGroup) + := pMap (B G) (B H). + +Definition grouphom_fun {G H} (phi : ooGroupHom G H) : G -> H + := loops_functor phi. + +Coercion grouphom_fun : ooGroupHom >-> Funclass. + +Definition group_loops_functor + {X Y : pType} (f : pMap X Y) +: ooGroupHom (group_loops X) (group_loops Y). +Proof. + simple refine (Build_pMap _ _ _ _); simpl. + - + intros [x p]. + exists (f x). + strip_truncations; apply tr. + exact (ap f p @ point_eq f). + - + apply path_sigma_hprop; simpl. + apply point_eq. +Defined. + +Definition loops_functor_group + {X Y : pType} (f : pMap X Y) +: loops_functor (group_loops_functor f) o loops_group X + == loops_group Y o loops_functor f. +admit. +Defined. + +Definition grouphom_compose {G H K : ooGroup} + (psi : ooGroupHom H K) (phi : ooGroupHom G H) +: ooGroupHom G K + := pmap_compose psi phi. + +Definition group_loops_functor_compose + {X Y Z : pType} + (psi : pMap Y Z) (phi : pMap X Y) +: grouphom_compose (group_loops_functor psi) (group_loops_functor phi) + == group_loops_functor (pmap_compose psi phi). +Proof. + intros g. + unfold grouphom_fun, grouphom_compose. + refine (pointed_htpy (loops_functor_compose _ _) g @ _). + pose (p := eisretr (loops_group X) g). + change (loops_functor (group_loops_functor psi) + (loops_functor (group_loops_functor phi) g) + = loops_functor (group_loops_functor + (pmap_compose psi phi)) g). + rewrite <- p. + Fail Timeout 1 Time rewrite !loops_functor_group. + (* 0.004 s in 8.5rc1, 8.677 s in 8.5 *) + Timeout 1 do 3 rewrite loops_functor_group. +Abort. diff --git a/test-suite/bugs/closed/bug_4574.v b/test-suite/bugs/closed/bug_4574.v new file mode 100644 index 0000000000..f166eb84a9 --- /dev/null +++ b/test-suite/bugs/closed/bug_4574.v @@ -0,0 +1,7 @@ +Require Import Setoid. + +Definition block A (a : A) := a. + +Goal forall A (a : A), block Type nat. +Proof. +Fail reflexivity. diff --git a/test-suite/bugs/closed/bug_4576.v b/test-suite/bugs/closed/bug_4576.v new file mode 100644 index 0000000000..2c643ea779 --- /dev/null +++ b/test-suite/bugs/closed/bug_4576.v @@ -0,0 +1,3 @@ +Definition foo := O. +Arguments foo : simpl nomatch. +Timeout 1 Eval cbn in id foo. diff --git a/test-suite/bugs/closed/bug_4580.v b/test-suite/bugs/closed/bug_4580.v new file mode 100644 index 0000000000..4ffd5f0f4b --- /dev/null +++ b/test-suite/bugs/closed/bug_4580.v @@ -0,0 +1,6 @@ +Require Import Program. + +Class Foo (A : Type) := foo : A. + +Unset Refine Instance Mode. +Program Instance f1 : Foo nat := S _. diff --git a/test-suite/bugs/closed/bug_4582.v b/test-suite/bugs/closed/bug_4582.v new file mode 100644 index 0000000000..0842fb8fa7 --- /dev/null +++ b/test-suite/bugs/closed/bug_4582.v @@ -0,0 +1,10 @@ +Require List. +Import List.ListNotations. + +Variable Foo : nat -> nat. + +Delimit Scope Foo_scope with F. + +Notation " [ x ] " := (Foo x) : Foo_scope. + +Check ([1] : nat)%F. diff --git a/test-suite/bugs/closed/bug_4588.v b/test-suite/bugs/closed/bug_4588.v new file mode 100644 index 0000000000..ff66277e03 --- /dev/null +++ b/test-suite/bugs/closed/bug_4588.v @@ -0,0 +1,10 @@ +Set Primitive Projections. + +(* This proof was accepted in Coq 8.5 because the subterm specs were not +projected correctly *) +Inductive foo : Prop := mkfoo { proj1 : False -> foo; proj2 : (forall P : Prop, P -> P) }. + +Fail Fixpoint loop (x : foo) : False := + loop (proj2 x _ x). + +Fail Definition bad : False := loop (mkfoo (fun x => match x with end) (fun _ x => x)). diff --git a/test-suite/bugs/closed/bug_4596.v b/test-suite/bugs/closed/bug_4596.v new file mode 100644 index 0000000000..592fdb6580 --- /dev/null +++ b/test-suite/bugs/closed/bug_4596.v @@ -0,0 +1,14 @@ +Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. + +Definition T (x : bool) := x = true. + +Goal forall (S : Type) (b b0 : S -> nat -> bool) (str : S) (p : nat) + (s : forall n : nat, bool) + (s0 s1 : nat -> S -> S), + (forall (str0 : S) (n m : nat), + (if s m then T (b0 (s1 n str0) 0) else T (b (s1 n str0) 0)) -> T (b (s0 n str0) m) -> + T (b str0 m)) -> + T (b str p). +Proof. +intros ???????? H0. +rewrite H0. diff --git a/test-suite/bugs/closed/bug_4603.v b/test-suite/bugs/closed/bug_4603.v new file mode 100644 index 0000000000..1879c06d49 --- /dev/null +++ b/test-suite/bugs/closed/bug_4603.v @@ -0,0 +1,10 @@ +Axiom A : Type. + +Goal True. exact I. +Check (fun P => P A). +Abort. + +Goal True. +Definition foo (A : Type) : Prop:= True. + set (x:=foo). split. +Qed. diff --git a/test-suite/bugs/closed/bug_4612.v b/test-suite/bugs/closed/bug_4612.v new file mode 100644 index 0000000000..ce95f26acc --- /dev/null +++ b/test-suite/bugs/closed/bug_4612.v @@ -0,0 +1,7 @@ +(* While waiting for support, check at least that it does not raise an anomaly *) + +Inductive ctype := +| Struct: list ctype -> ctype +| Bot : ctype. + +Fail Scheme Equality for ctype. diff --git a/test-suite/bugs/closed/bug_4616.v b/test-suite/bugs/closed/bug_4616.v new file mode 100644 index 0000000000..d6660e3553 --- /dev/null +++ b/test-suite/bugs/closed/bug_4616.v @@ -0,0 +1,7 @@ +Require Coq.extraction.Extraction. + +Set Primitive Projections. +Record Foo' := Foo { foo : Type }. +Definition f := forall t : Foo', foo t. +Extraction f. +Extraction TestCompile f. diff --git a/test-suite/bugs/closed/bug_4622.v b/test-suite/bugs/closed/bug_4622.v new file mode 100644 index 0000000000..ffa478cb87 --- /dev/null +++ b/test-suite/bugs/closed/bug_4622.v @@ -0,0 +1,24 @@ +Set Primitive Projections. + +Record foo : Type := bar { x : unit }. + +Goal forall t u, bar t = bar u -> t = u. +Proof. + intros. + injection H. + trivial. +Qed. +(* Was: Error: Pattern-matching expression on an object of inductive type foo has invalid information. *) + +(** Dependent pattern-matching is ok on this one as it has eta *) +Definition baz (x : foo) := + match x as x' return x' = x' with + | bar u => eq_refl + end. + +Inductive foo' : Type := bar' {x' : unit; y: foo'}. +(** Dependent pattern-matching is not ok on this one *) +Fail Definition baz' (x : foo') := + match x as x' return x' = x' with + | bar' u y => eq_refl + end. diff --git a/test-suite/bugs/closed/bug_4623.v b/test-suite/bugs/closed/bug_4623.v new file mode 100644 index 0000000000..7ecfd98b67 --- /dev/null +++ b/test-suite/bugs/closed/bug_4623.v @@ -0,0 +1,5 @@ +Goal Type -> Type. +set (T := Type). +clearbody T. +refine (@id _). +Qed. diff --git a/test-suite/bugs/closed/bug_4624.v b/test-suite/bugs/closed/bug_4624.v new file mode 100644 index 0000000000..f5ce981cd0 --- /dev/null +++ b/test-suite/bugs/closed/bug_4624.v @@ -0,0 +1,7 @@ +Record foo := mkfoo { type : Type }. + +Canonical Structure fooA (T : Type) := mkfoo (T -> T). + +Definition id (t : foo) (x : type t) := x. + +Definition bar := id _ ((fun x : nat => x) : _). diff --git a/test-suite/bugs/closed/bug_4627.v b/test-suite/bugs/closed/bug_4627.v new file mode 100644 index 0000000000..4f56e19584 --- /dev/null +++ b/test-suite/bugs/closed/bug_4627.v @@ -0,0 +1,49 @@ +Class sa (A:Type) := { }. + +Record predicate A (sa:sa A) := + { pred_fun: A->Prop }. +Record ABC : Type := + { abc: Type }. +Record T := + { T_abc: ABC }. + + +(* +sa: forall _ : Type@{Top.179}, Prop +predicate: forall (A : Type@{Top.205}) (_ : sa A), Type@{max(Set+1, Top.205)} +T: Type@{Top.208+1} +ABC: Type@{Top.208+1} +abc: forall _ : ABC, Type@{Top.208} + +Top.205 <= Top.179 predicate <= sa.A +Set < Top.208 Set < abc +Set < Top.205 Set < predicate +*) + +Definition foo : predicate T (Build_sa T) := + {| pred_fun:= fun w => True |}. +(* *) +(* Top.208 < Top.205 <--- added by foo *) +(* *) + +Check predicate nat (Build_sa nat). +(* + +The issue is that the template polymorphic universe of [predicate], Top.205, does not get replaced with the universe of [nat] in the above line. + -Jason Gross + +8.5 -- predicate nat (Build_sa nat): Type@{max(Set+1, Top.205)} +8.5 EXPECTED -- predicate nat (Build_sa nat): Type@{Set+1} +8.4pl4 -- predicate nat {| |}: Type (* max(Set, (Set)+1) *) +*) + +(* This works in 8.4pl4 and SHOULD work in 8.5 *) +Definition bar : ABC := + {| abc:= predicate nat (Build_sa nat) |}. +(* +The term "predicate nat (Build_sa nat)" has type + "Type@{max(Set+1, Top.205)}" +while it is expected to have type "Type@{Top.208}" +(universe inconsistency: Cannot enforce Top.205 <= +Top.208 because Top.208 < Top.205). +*) diff --git a/test-suite/bugs/closed/bug_4628.v b/test-suite/bugs/closed/bug_4628.v new file mode 100644 index 0000000000..7d4a15d689 --- /dev/null +++ b/test-suite/bugs/closed/bug_4628.v @@ -0,0 +1,46 @@ +Module first. + Polymorphic Record BAR (A:Type) := + { foo: A->Prop; bar: forall (x y: A), foo x -> foo y}. + +Section A. +Context {A:Type}. + +Set Printing Universes. + +Hint Resolve bar. +Goal forall (P:BAR A) x y, foo _ P x -> foo _ P y. +intros. +eauto. +Qed. +End A. +End first. + +Module firstbest. + Polymorphic Record BAR (A:Type) := + { foo: A->Prop; bar: forall (x y: A), foo x -> foo y}. + +Section A. +Context {A:Type}. + +Set Printing Universes. + +Polymorphic Hint Resolve bar. +Goal forall (P:BAR A) x y, foo _ P x -> foo _ P y. +intros. +eauto. +Qed. +End A. +End firstbest. + +Module second. +Axiom foo: Set. +Axiom foo': Set. + +Polymorphic Record BAR (A:Type) := + { bar: foo' -> foo}. +Set Printing Universes. + +Lemma baz@{i}: forall (P:BAR@{Set} nat), foo' -> foo. + eauto using bar. +Qed. +End second. diff --git a/test-suite/bugs/closed/bug_4634.v b/test-suite/bugs/closed/bug_4634.v new file mode 100644 index 0000000000..77e31e108f --- /dev/null +++ b/test-suite/bugs/closed/bug_4634.v @@ -0,0 +1,16 @@ +Set Primitive Projections. + +Polymorphic Record pair {A B : Type} : Type := + prod { pr1 : A; pr2 : B }. + +Notation " ( x ; y ) " := (@prod _ _ x y). +Notation " x .1 " := (pr1 x) (at level 3). +Notation " x .2 " := (pr2 x) (at level 3). + +Goal ((0; 1); 2).1.2 = 1. +Proof. + cbv. + match goal with + | |- ?t = ?t => exact (eq_refl t) + end. +Qed. diff --git a/test-suite/bugs/closed/bug_4644.v b/test-suite/bugs/closed/bug_4644.v new file mode 100644 index 0000000000..f09b27c2b1 --- /dev/null +++ b/test-suite/bugs/closed/bug_4644.v @@ -0,0 +1,52 @@ +(* Testing a regression of unification in 8.5 in problems of the form + "match ?y with ... end = ?x args" *) + +Lemma foo : exists b, forall a, match a with tt => tt end = b a. +Proof. +eexists. intro. +refine (_ : _ = match _ with tt => _ end). +refine eq_refl. +Qed. + +(**********************************************************************) + +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Export Coq.Classes.Morphisms. +Require Import Coq.Lists.List. + +Global Set Implicit Arguments. + +Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs)) + ls + : P ls + := match ls with + | nil => N + | x::xs => C x xs + end. + +Axiom list_caset_Proper' + : forall {A P}, + Proper (eq + ==> pointwise_relation _ (pointwise_relation _ eq) + ==> eq + ==> eq) + (@list_caset A (fun _ => P)). +Goal forall (T T' : Set) (a3 : list T), exists y2, forall (a4 : T' -> bool), + match a3 with + | nil => 0 + | (_ :: _)%list => 1 + end = y2 a4. + clear; eexists; intros. + reflexivity. Undo. + Local Ltac t := + lazymatch goal with + | [ |- match ?v with nil => ?N | cons x xs => @?C x xs end = _ :> ?P ] + => let T := type of v in + let A := match (eval hnf in T) with list ?A => A end in + refine (@list_caset_Proper' A P _ _ _ _ _ _ _ _ _ + : @list_caset A (fun _ => P) N C v = match _ with nil => _ | cons x xs => _ end) + end. + (etransitivity; [ t | reflexivity ]) || fail 0 "too early". + Undo. + t. diff --git a/test-suite/bugs/closed/bug_4653.v b/test-suite/bugs/closed/bug_4653.v new file mode 100644 index 0000000000..4514342c5e --- /dev/null +++ b/test-suite/bugs/closed/bug_4653.v @@ -0,0 +1,3 @@ +Definition T := Type. +Module Type S. Parameter foo : let A := T in True. End S. +Module M <: S. Lemma foo (A := T) : True. Proof I. End M. diff --git a/test-suite/bugs/closed/bug_4661.v b/test-suite/bugs/closed/bug_4661.v new file mode 100644 index 0000000000..03d2350a69 --- /dev/null +++ b/test-suite/bugs/closed/bug_4661.v @@ -0,0 +1,10 @@ +Module Type Test. + Parameter t : Type. +End Test. + +Module Type Func (T:Test). + Parameter x : Type. +End Func. + +Module Shortest_path (T : Test). +Print Func. diff --git a/test-suite/bugs/closed/bug_4663.v b/test-suite/bugs/closed/bug_4663.v new file mode 100644 index 0000000000..b76619882a --- /dev/null +++ b/test-suite/bugs/closed/bug_4663.v @@ -0,0 +1,3 @@ +Coercion foo (n : nat) : Set. +Admitted. +Check (0 : Set). diff --git a/test-suite/bugs/closed/bug_4670.v b/test-suite/bugs/closed/bug_4670.v new file mode 100644 index 0000000000..6113992953 --- /dev/null +++ b/test-suite/bugs/closed/bug_4670.v @@ -0,0 +1,7 @@ +Require Import Coq.Vectors.Vector. +Module Bar. + Definition foo A n (l : Vector.t A n) : True. + Proof. + induction l ; exact I. + Defined. +End Bar. diff --git a/test-suite/bugs/closed/bug_4673.v b/test-suite/bugs/closed/bug_4673.v new file mode 100644 index 0000000000..0d49c6d9be --- /dev/null +++ b/test-suite/bugs/closed/bug_4673.v @@ -0,0 +1,57 @@ +(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerOptimized" "-R" "." "Top") -*- *) +(* File reduced by coq-bug-finder from original input, then from 2407 lines to 22 lines, then from 528 lines to 35 lines, then from 331 lines to 42 lines, then from 56 lines to 42 lines, then from 63 lines to 46 lines, then from 60 lines to 46 lines *) (* coqc version 8.5 (February 2016) compiled on Feb 21 2016 15:26:16 with OCaml 4.02.3 + coqtop version 8.5 (February 2016) *) +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Coq.Lists.List. +Import Coq.Lists.List. +Import Coq.Classes.Morphisms. + +Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs)) + ls + : P ls + := match ls with + | nil => N + | x::xs => C x xs + end. + +Global Instance list_caset_Proper' {A P} + : Proper (eq + ==> pointwise_relation _ (pointwise_relation _ eq) + ==> eq + ==> eq) + (@list_caset A (fun _ => P)). +admit. +Defined. + +Global Instance list_caset_Proper'' {A P} + : (Proper (eq ==> pointwise_relation _ (pointwise_relation _ eq) ==> forall_relation (fun _ => eq)) + (list_caset A (fun _ => P))). +Admitted. + +Goal forall (Char : Type) (P : forall _ : list bool, Prop) (l : list bool) (l0 : forall _ : forall _ : Char, bool, list bool) + + (T : Type) (T0 : forall _ : T, Type) (t : T), + + let predata := t in + + forall (splitdata : T0 predata) (l5 : forall _ : T0 t, list nat) (T1 : Type) (b : forall (_ : T1) (_ : Char), bool) + + (T2 : Type) (a11 : T2) (xs : list T2) (T3 : Type) (i0 : T3) (P0 : Set) (b1 : forall (_ : nat) (_ : P0), bool) + + (l2 : forall (_ : forall _ : T1, list bool) (_ : forall _ : P0, list bool) (_ : T2), list bool) + + (l1 : forall (_ : forall _ : forall _ : Char, bool, list bool) (_ : forall _ : P0, list bool) (_ : T3), list bool) + + (_ : forall NT : forall _ : P0, list bool, @eq (list bool) (l1 l0 NT i0) (l2 (fun f : T1 => l0 (b f)) NT a11)), + + P + (@list_caset T2 (fun _ : list T2 => list bool) l + (fun (_ : T2) (_ : list T2) => l1 l0 (fun a9 : P0 => @map nat bool (fun x0 : nat => b1 x0 a9) (l5 splitdata)) i0 +) xs). + intros. + subst predata; + let H := match goal with H : forall _, _ = _ |- _ => H end in + setoid_rewrite H || fail 0 "too early". + Undo. + setoid_rewrite H. diff --git a/test-suite/bugs/closed/bug_4679.v b/test-suite/bugs/closed/bug_4679.v new file mode 100644 index 0000000000..3f41c5d6b1 --- /dev/null +++ b/test-suite/bugs/closed/bug_4679.v @@ -0,0 +1,18 @@ +Require Import Coq.Setoids.Setoid. +Goal forall (T : nat -> Set -> Set) (U : Set) + (H : forall n : nat, T n (match n with + | 0 => fun x => x + | S _ => fun x => x + end (nat = nat)) = U), + T 0 (nat = nat) = U. +Proof. + intros. + let H := match goal with H : forall _, eq _ _ |- _ => H end in + rewrite H || fail 0 "too early". + Undo. + let H := match goal with H : forall _, eq _ _ |- _ => H end in + setoid_rewrite (H 0) || fail 0 "too early". + Undo. + setoid_rewrite H. (* Error: Tactic failure: setoid rewrite failed: Nothing to rewrite. *) + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_4684.v b/test-suite/bugs/closed/bug_4684.v new file mode 100644 index 0000000000..9c0bed42c4 --- /dev/null +++ b/test-suite/bugs/closed/bug_4684.v @@ -0,0 +1,32 @@ +(*Suppose a user wants to declare a new list-like notation with support for singletons in both 8.4 and 8.5. If they use*) +Require Import Coq.Lists.List. +Require Import Coq.Vectors.Vector. +Import ListNotations. +Import VectorNotations. +Set Implicit Arguments. +Inductive mylist T := mynil | mycons (_ : T) (_ : mylist T). +Arguments mynil {_}, _. + +Delimit Scope mylist_scope with mylist. +Bind Scope mylist_scope with mylist. +Delimit Scope vector_scope with vector. + +Notation " [ ] " := mynil (format "[ ]") : mylist_scope. +Notation " [ x ] " := (mycons x mynil) : mylist_scope. +Notation " [ x ; y ; .. ; z ] " := (mycons x (mycons y .. (mycons z mynil) ..)) : mylist_scope. + +Check [ ]%mylist : mylist _. +Check [ ]%list : list _. +Check []%vector : Vector.t _ _. +Check [ _ ]%mylist : mylist _. +Check [ _ ]%list : list _. +Check [ _ ]%vector : Vector.t _ _. +Check [ _ ; _ ]%list : list _. +Check [ _ ; _ ]%vector : Vector.t _ _. +Check [ _ ; _ ]%mylist : mylist _. +Check [ _ ; _ ; _ ]%list : list _. +Check [ _ ; _ ; _ ]%vector : Vector.t _ _. +Check [ _ ; _ ; _ ]%mylist : mylist _. +Check [ _ ; _ ; _ ; _ ]%list : list _. +Check [ _ ; _ ; _ ; _ ]%vector : Vector.t _ _. +Check [ _ ; _ ; _ ; _ ]%mylist : mylist _. diff --git a/test-suite/bugs/closed/bug_4695.v b/test-suite/bugs/closed/bug_4695.v new file mode 100644 index 0000000000..27e35c2ac0 --- /dev/null +++ b/test-suite/bugs/closed/bug_4695.v @@ -0,0 +1,38 @@ +(* +The Qed at the end of this file was slow in 8.5 and 8.5pl1 because the kernel +term comparison after evaluation was done on constants according to their user +names. The conversion still succeeded because delta applied, but was much +slower than with a canonical names comparison. +*) + +Module Mod0. + + Fixpoint rec_ t d : nat := + match d with + | O => O + | S d' => + match t with + | true => rec_ t d' + | false => rec_ t d' + end + end. + + Definition depth := 1000. + + Definition rec t := rec_ t depth. + +End Mod0. + + +Module Mod1. + Module M := Mod0. +End Mod1. + + +Axiom rec_prop : forall t d n, Mod1.M.rec_ t d = n. + +Lemma slow_qed : forall t n, + Mod0.rec t = n. +Proof. + intros; unfold Mod0.rec; apply rec_prop. +Timeout 2 Qed. diff --git a/test-suite/bugs/closed/bug_4708.v b/test-suite/bugs/closed/bug_4708.v new file mode 100644 index 0000000000..ad2e581004 --- /dev/null +++ b/test-suite/bugs/closed/bug_4708.v @@ -0,0 +1,8 @@ +(*Doc, it hurts when I poke myself.*) + +Notation "'" := 1. (* was: +Setting notation at level 0. +Toplevel input, characters 0-18: +> Notation "'" := 1. +> ^^^^^^^^^^^^^^^^^^ +Anomaly: Uncaught exception Invalid_argument("index out of bounds"). Please report. *) diff --git a/test-suite/bugs/closed/bug_4709.v b/test-suite/bugs/closed/bug_4709.v new file mode 100644 index 0000000000..a9edcc8043 --- /dev/null +++ b/test-suite/bugs/closed/bug_4709.v @@ -0,0 +1,18 @@ + +(** Bug 4709 https://coq.inria.fr/bug/4709 + Extraction wasn't reducing primitive projections in types. *) + +Require Extraction. + +Set Primitive Projections. + +Record t := Foo { foo : Type }. +Definition ty := foo (Foo nat). + +(* Without proper reduction of primitive projections in + [extract_type], the type [ty] was extracted as [Tunknown]. + Let's check it isn't the case anymore. *) + +Parameter check : nat. +Extract Constant check => "(O:ty)". +Extraction TestCompile ty check. diff --git a/test-suite/bugs/closed/bug_4710.v b/test-suite/bugs/closed/bug_4710.v new file mode 100644 index 0000000000..e792a36234 --- /dev/null +++ b/test-suite/bugs/closed/bug_4710.v @@ -0,0 +1,15 @@ +Require Coq.extraction.Extraction. + +Set Primitive Projections. +Record Foo' := Foo { foo : nat }. +Extraction foo. +Record Foo2 (a : nat) := Foo2c { foo2p : nat; foo2b : bool }. +Extraction foo2p. + +Definition bla (x : Foo2 0) := foo2p _ x. +Extraction bla. + +Definition bla' (a : nat) (x : Foo2 a) := foo2b _ x. +Extraction bla'. + +Extraction TestCompile foo foo2p bla bla'. diff --git a/test-suite/bugs/closed/bug_4713.v b/test-suite/bugs/closed/bug_4713.v new file mode 100644 index 0000000000..5d4d73be3f --- /dev/null +++ b/test-suite/bugs/closed/bug_4713.v @@ -0,0 +1,10 @@ +Module Type T. + Parameter t : Type. +End T. +Module M : T. + Definition t := unit. +End M. + +Fail Module Z : T with Module t := M := M. +Fail Module Z <: T with Module t := M := M. +Fail Declare Module Z : T with Module t := M. diff --git a/test-suite/bugs/closed/bug_4717.v b/test-suite/bugs/closed/bug_4717.v new file mode 100644 index 0000000000..bd9bac37ef --- /dev/null +++ b/test-suite/bugs/closed/bug_4717.v @@ -0,0 +1,33 @@ +(* Omega being smarter on recognizing nat and Z *) + +Require Import Omega. + +Definition nat' := nat. + +Theorem le_not_eq_lt : forall (n m:nat), + n <= m -> + n <> m :> nat' -> + n < m. +Proof. + intros. + omega. +Qed. + +Goal forall (x n : nat'), x = x + n - n. +Proof. + intros. + omega. +Qed. + +Open Scope Z_scope. + +Definition Z' := Z. + +Theorem Zle_not_eq_lt : forall n m, + n <= m -> + n <> m :> Z' -> + n < m. +Proof. + intros. + omega. +Qed. diff --git a/test-suite/bugs/closed/bug_4718.v b/test-suite/bugs/closed/bug_4718.v new file mode 100644 index 0000000000..12a4e8fc1a --- /dev/null +++ b/test-suite/bugs/closed/bug_4718.v @@ -0,0 +1,15 @@ +(*Congruence is weaker than reflexivity when it comes to higher level than necessary equalities:*) + +Goal @eq Set nat nat. +congruence. +Qed. + +Goal @eq Type nat nat. +congruence. (*bug*) +Qed. + +Variable T : Type. + +Goal @eq Type T T. +congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_4720.v b/test-suite/bugs/closed/bug_4720.v new file mode 100644 index 0000000000..704331e784 --- /dev/null +++ b/test-suite/bugs/closed/bug_4720.v @@ -0,0 +1,50 @@ +(** Bug 4720 : extraction and "with" in module type *) + +Module Type A. + Parameter t : Set. +End A. + +Module A_instance <: A. + Definition t := nat. +End A_instance. + +Module A_private : A. + Definition t := nat. +End A_private. + +Module Type B. +End B. + +Module Type C (b : B). + Declare Module a : A. +End C. + +Module WithMod (a' : A) (b' : B) (c' : C b' with Module a := A_instance). +End WithMod. + +Module WithDef (a' : A) (b' : B) (c' : C b' with Definition a.t := nat). +End WithDef. + +Module WithModPriv (a' : A) (b' : B) (c' : C b' with Module a := A_private). +End WithModPriv. + +(* The initial bug report was concerning the extraction of WithModPriv + in Coq 8.4, which was suboptimal: it was compiling, but could have been + turned into some faulty code since A_private and c'.a were not seen as + identical by the extraction. + + In Coq 8.5 and 8.6, the extractions of WithMod, WithDef, WithModPriv + were all causing Anomaly or Assert Failure. This shoud be fixed now. +*) + +Require Extraction. + +Recursive Extraction WithMod. + +Recursive Extraction WithDef. + +Recursive Extraction WithModPriv. + +(* Let's even check that all this extracted code is actually compilable: *) + +Extraction TestCompile WithMod WithDef WithModPriv. diff --git a/test-suite/bugs/closed/bug_4723.v b/test-suite/bugs/closed/bug_4723.v new file mode 100644 index 0000000000..5fb9696f3f --- /dev/null +++ b/test-suite/bugs/closed/bug_4723.v @@ -0,0 +1,28 @@ + +Require Coq.Program.Tactics. + +Record Matrix (m n : nat). + +Definition kp {m n p q: nat} (A: Matrix m n) (B: Matrix p q): + Matrix (m*p) (n*q). Admitted. + +Fail Program Fact kp_assoc + (xr xc yr yc zr zc: nat) + (x: Matrix xr xc) (y: Matrix yr yc) (z: Matrix zr zc): + kp x (kp y z) = kp (kp x y) z. + +Ltac Obligation Tactic := admit. +Fail Program Fact kp_assoc + (xr xc yr yc zr zc: nat) + (x: Matrix xr xc) (y: Matrix yr yc) (z: Matrix zr zc): + kp x (kp y z) = kp (kp x y) z. + +Axiom cheat : forall {A}, A. +Obligation Tactic := apply cheat. + +Program Fact kp_assoc + (xr xc yr yc zr zc: nat) + (x: Matrix xr xc) (y: Matrix yr yc) (z: Matrix zr zc): + kp x (kp y z) = kp (kp x y) z. +admit. +Admitted. diff --git a/test-suite/bugs/closed/bug_4725.v b/test-suite/bugs/closed/bug_4725.v new file mode 100644 index 0000000000..fd5e0fb60d --- /dev/null +++ b/test-suite/bugs/closed/bug_4725.v @@ -0,0 +1,38 @@ +Require Import EquivDec Equivalence List Program. +Require Import Relation_Definitions. +Import ListNotations. +Generalizable All Variables. + +Fixpoint removeV `{eqDecV : @EqDec V eqV equivV}`(x : V) (l : list V) : list V +:= + match l with + | nil => nil + | y::tl => if (equiv_dec x y) then removeV x tl else y::(removeV x tl) + end. + +Lemma remove_le {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV : +@EqDec V eqV equivV} (xs : list V) (x : V) : + length (removeV x xs) < length (x :: xs). + Proof. Admitted. + +(* Function version *) +Set Printing Universes. + +Require Import Recdef. + +Function nubV {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV : +@EqDec V eqV equivV} (l : list V) { measure length l} := + match l with + | nil => nil + | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs) + end. +Proof. intros. apply remove_le. Qed. + +(* Program version *) + +Program Fixpoint nubV `{eqDecV : @EqDec V eqV equivV} (l : list V) + { measure (@length V l) lt } := + match l with + | nil => nil + | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs) _ + end. diff --git a/test-suite/bugs/closed/bug_4726.v b/test-suite/bugs/closed/bug_4726.v new file mode 100644 index 0000000000..cb87e9e409 --- /dev/null +++ b/test-suite/bugs/closed/bug_4726.v @@ -0,0 +1,19 @@ +Set Universe Polymorphism. + +Definition le@{i j} : Type@{j} := + (fun A : Type@{j} => A) + (unit : Type@{i}). +Definition eq@{i j} : Type@{j} := let x := le@{i j} in le@{j i}. + +Record Inj@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} := + { inj : A }. + +Monomorphic Universe u1. +Let ty1 : Type@{u1} := Set. +Check Inj@{Set u1}. +(* Would fail with univ inconsistency if the universe was minimized *) + +Record Inj'@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} := + { inj' : A; foo : Type@{j} := eq@{i j} }. +Fail Check Inj'@{Set u1}. (* Do not drop constraint i = j *) +Check Inj'@{Set Set}. diff --git a/test-suite/bugs/closed/bug_4737.v b/test-suite/bugs/closed/bug_4737.v new file mode 100644 index 0000000000..84ed45e454 --- /dev/null +++ b/test-suite/bugs/closed/bug_4737.v @@ -0,0 +1,9 @@ +Goal True. +Proof. +exact I; cycle 1. +Qed. + +Goal True. +Proof. +exact I; swap 1 2. +Qed. diff --git a/test-suite/bugs/closed/bug_4745.v b/test-suite/bugs/closed/bug_4745.v new file mode 100644 index 0000000000..c090125e64 --- /dev/null +++ b/test-suite/bugs/closed/bug_4745.v @@ -0,0 +1,35 @@ +(*I get an Anomaly in the following code. + +```*) +Require Vector. + +Module M. + Lemma Vector_map_map : + forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n), + Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v. + Proof. + induction v; simpl; auto using f_equal. + Qed. + + Lemma Vector_map_map_transparent : + forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n), + Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v. + Proof. + induction v; simpl; auto using f_equal. + Defined. + (* Anomaly: constant not found in kind_of_head: Coq.Vectors.Vector.t_ind. Please report. *) + + (* strangely, explicitly passing the principle to induction works *) + Lemma Vector_map_map_transparent' : + forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n), + Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v. + Proof. + induction v using Vector.t_ind; simpl; auto using f_equal. + Defined. +End M. +(*``` + +Changing any of the following things eliminates the Anomaly + * moving the lemma out of the module M to the top level + * proving the lemma as a Fixpoint instead of using induction + * proving the analogous lemma on lists instead of vectors*) diff --git a/test-suite/bugs/closed/bug_4746.v b/test-suite/bugs/closed/bug_4746.v new file mode 100644 index 0000000000..d64cc6fe68 --- /dev/null +++ b/test-suite/bugs/closed/bug_4746.v @@ -0,0 +1,14 @@ +Variables P Q : nat -> Prop. +Variable f : nat -> nat. + +Goal forall (x:nat), (forall y, P y -> forall z, Q z -> y=f z -> False) -> False. +Proof. +intros. +ecase H with (3:=eq_refl). +Abort. + +Goal forall (x:nat), (forall y, y=x -> False) -> False. +Proof. +intros. +unshelve ecase H with (1:=eq_refl). +Qed. diff --git a/test-suite/bugs/closed/bug_4754.v b/test-suite/bugs/closed/bug_4754.v new file mode 100644 index 0000000000..67d645a68f --- /dev/null +++ b/test-suite/bugs/closed/bug_4754.v @@ -0,0 +1,35 @@ + +Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. +Definition f (v : option nat) := match v with + | Some k => Some k + | None => None + end. + +Axioms F G : (option nat -> option nat) -> Prop. +Axiom FG : forall f, f None = None -> F f = G f. + +Axiom admit : forall {T}, T. + +Existing Instance eq_Reflexive. + +Global Instance foo (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +Global Instance bar (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> eq ==> Basics.flip Basics.impl) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. +Proof. + intro. + pose proof (_ : (Proper (_ ==> eq ==> _) and)). + setoid_rewrite (FG _ _); [ | reflexivity.. ]. + Undo. + setoid_rewrite (FG _ eq_refl). (* Error: Tactic failure: setoid rewrite failed: Nothing to rewrite. in 8.5 *) Admitted. diff --git a/test-suite/bugs/closed/bug_4762.v b/test-suite/bugs/closed/bug_4762.v new file mode 100644 index 0000000000..62e2abbf98 --- /dev/null +++ b/test-suite/bugs/closed/bug_4762.v @@ -0,0 +1,23 @@ +Inductive myand (P Q : Prop) := myconj : P -> Q -> myand P Q. + +Lemma foo P Q R : R = myand P Q -> P -> Q -> R. +Proof. intros ->; constructor; auto. Qed. + +Hint Extern 0 (myand _ _) => eapply foo; [reflexivity| |] : test1. + +Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R). +Proof. + intros. + eauto with test1. +Qed. + +Hint Extern 0 => + match goal with + | |- myand _ _ => eapply foo; [reflexivity| |] + end : test2. + +Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R). +Proof. + intros. + eauto with test2. (* works *) +Qed. diff --git a/test-suite/bugs/closed/bug_4763.v b/test-suite/bugs/closed/bug_4763.v new file mode 100644 index 0000000000..9613b5c248 --- /dev/null +++ b/test-suite/bugs/closed/bug_4763.v @@ -0,0 +1,13 @@ +Require Import Coq.Arith.Arith Coq.Classes.Morphisms Coq.Classes.RelationClasses. +Coercion is_true : bool >-> Sortclass. +Global Instance: Transitive leb. +Admitted. + +Goal forall x y z, leb x y -> leb y z -> True. + intros ??? H H'. + lazymatch goal with + | [ H : is_true (?R ?x ?y), H' : is_true (?R ?y ?z) |- _ ] + => pose proof (transitivity H H' : is_true (R x z)) + end. + exact I. +Qed. diff --git a/test-suite/bugs/closed/bug_4764.v b/test-suite/bugs/closed/bug_4764.v new file mode 100644 index 0000000000..e545cc1b71 --- /dev/null +++ b/test-suite/bugs/closed/bug_4764.v @@ -0,0 +1,5 @@ +Notation prop_fun x y := (fun (x : Prop) => y). +Definition foo := fun (p : Prop) => p. +Definition bar := fun (_ : Prop) => O. +Print foo. +Print bar. diff --git a/test-suite/bugs/closed/bug_4769.v b/test-suite/bugs/closed/bug_4769.v new file mode 100644 index 0000000000..34ce03d231 --- /dev/null +++ b/test-suite/bugs/closed/bug_4769.v @@ -0,0 +1,94 @@ + +(* -*- mode: coq; coq-prog-args: ("-nois" "-R" "." "Top" "-top" "bug_hom_anom_10") -*- *) +(* File reduced by coq-bug-finder from original input, then from 156 lines to 41 lines, then from 237 lines to 45 lines, then from 163 lines to 66 lines, then from 342 lines to 121 lines, then from 353 lines to 184 lines, then from 343 lines to 255 lines, then from 435 lines to 322 lines, then from 475 lines to 351 lines, then from 442 lines to 377 lines, then from 505 lines to 410 lines, then from 591 lines to 481 lines, then from 596 lines to 535 lines, then from 647 lines to 570 lines, then from 669 lines to 596 lines, then from 687 lines to 620 lines, then from 728 lines to 652 lines, then from 1384 lines to 683 lines, then from 984 lines to 707 lines, then from 1124 lines to 734 lines, then from 775 lines to 738 lines, then from 950 lines to 763 lines, then from 857 lines to 798 lines, then from 983 lines to 752 lines, then from 1598 lines to 859 lines, then from 873 lines to 859 lines, then from 875 lines to 862 lines, then from 901 lines to 863 lines, then from 1047 lines to 865 lines, then from 929 lines to 871 lines, then from 989 lines to 884 lines, then from 900 lines to 884 lines, then from 884 lines to 751 lines, then from 763 lines to 593 lines, then from 482 lines to 232 lines, then from 416 lines to 227 lines, then from 290 lines to 231 lines, then from 348 lines to 235 lines, then from 249 lines to 235 lines, then from 249 lines to 172 lines, then from 186 lines to 172 lines, then from 140 lines to 113 lines, then from 127 lines to 113 lines *) (* coqc version trunk (June 2016) compiled on Jun 2 2016 10:16:20 with OCaml 4.02.3 + coqtop version trunk (June 2016) *) + +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Reserved Notation "x * y" (at level 40, left associativity). +Delimit Scope type_scope with type. +Open Scope type_scope. +Global Set Universe Polymorphism. +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Set Implicit Arguments. +Global Set Nonrecursive Elimination Schemes. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Axiom admit : forall {T}, T. +Delimit Scope function_scope with function. +Notation compose := (fun g f x => g (f x)). +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. +Record PreCategory := + Build_PreCategory { + object :> Type; + morphism : object -> object -> Type; + identity : forall x, morphism x x }. +Bind Scope category_scope with PreCategory. +Record Functor (C D : PreCategory) := { object_of :> C -> D }. +Bind Scope functor_scope with Functor. +Class Isomorphic {C : PreCategory} (s d : C) := {}. +Definition oppositeC (C : PreCategory) : PreCategory + := @Build_PreCategory C (fun s d => morphism C d s) admit. +Notation "C ^op" := (oppositeC C) (at level 3, format "C '^op'") : category_scope. +Definition oppositeF C D (F : Functor C D) : Functor C^op D^op + := Build_Functor (C^op) (D^op) (object_of F). +Definition set_cat : PreCategory := @Build_PreCategory Type (fun x y => x -> y) admit. +Definition prodC (C D : PreCategory) : PreCategory + := @Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) + * morphism D (snd s) (snd d))%type) + admit. +Infix "*" := prodC : category_scope. +Section composition. + Variables B C D E : PreCategory. + Definition composeF (G : Functor D E) (F : Functor C D) : Functor C E := Build_Functor C E (fun c => G (F c)). +End composition. +Infix "o" := composeF : functor_scope. +Definition fstF {C D} : Functor (C * D) C := admit. +Definition sndF {C D} : Functor (C * D) D := admit. +Definition prodF C D D' (F : Functor C D) (F' : Functor C D') : Functor C (D * D') := admit. +Local Infix "*" := prodF : functor_scope. +Definition pairF C D C' D' (F : Functor C D) (F' : Functor C' D') : Functor (C * C') (D * D') + := (F o fstF) * (F' o sndF). +Section hom_functor. + Variable C : PreCategory. + Local Notation obj_of c'c := + ((morphism + C + (fst (c'c : object (C^op * C))) + (snd (c'c : object (C^op * C))))). + Definition hom_functor : Functor (C^op * C) set_cat + := Build_Functor (C^op * C) set_cat (fun c'c => obj_of c'c). +End hom_functor. +Definition identityF C : Functor C C := admit. +Definition functor_category (C D : PreCategory) : PreCategory + := @Build_PreCategory (Functor C D) admit admit. +Local Notation "C -> D" := (functor_category C D) : category_scope. +Definition NaturalIsomorphism (C D : PreCategory) F G := @Isomorphic (C -> D) F G. + +Section Adjunction. + Variables C D : PreCategory. + Variable F : Functor C D. + Variable G : Functor D C. + + Record AdjunctionHom := + { + mate_of : @NaturalIsomorphism + (prodC (oppositeC C) D) + (@set_cat) + (@composeF + (prodC (oppositeC C) D) + (prodC (oppositeC D) D) + (@set_cat) (@hom_functor D) + (@pairF (oppositeC C) + (oppositeC D) D D + (@oppositeF C D F) (identityF D))) + (@composeF + (prodC (oppositeC C) D) + (prodC (oppositeC C) C) + (@set_cat) (@hom_functor C) + (@pairF (oppositeC C) + (oppositeC C) D C + (identityF (oppositeC C)) G)) + }. +End Adjunction. diff --git a/test-suite/bugs/closed/bug_4772.v b/test-suite/bugs/closed/bug_4772.v new file mode 100644 index 0000000000..c3109fa31c --- /dev/null +++ b/test-suite/bugs/closed/bug_4772.v @@ -0,0 +1,6 @@ + +Record TruncType := BuildTruncType { + trunctype_type : Type +}. + +Fail Arguments BuildTruncType _ _ {_}. (* This should fail *) diff --git a/test-suite/bugs/closed/bug_4780.v b/test-suite/bugs/closed/bug_4780.v new file mode 100644 index 0000000000..7ed56d2179 --- /dev/null +++ b/test-suite/bugs/closed/bug_4780.v @@ -0,0 +1,105 @@ +(* -*- mode: coq; coq-prog-args: ("-R" "." "Top" "-top" "bug_bad_induction_01") -*- *) +(* File reduced by coq-bug-finder from original input, then from 1889 lines to 144 lines, then from 158 lines to 144 lines *) +(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3 + coqtop version 8.5pl1 (April 2016) *) +Axiom proof_admitted : False. +Tactic Notation "admit" := abstract case proof_admitted. +Global Set Universe Polymorphism. +Global Set Asymmetric Patterns. +Notation "'exists' x .. y , p" := (sigT (fun x => .. (sigT (fun y => p)) ..)) + (at level 200, x binder, right associativity, + format "'[' 'exists' '/ ' x .. y , '/ ' p ']'") + : type_scope. +Definition relation (A : Type) := A -> A -> Type. +Class Transitive {A} (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z. +Tactic Notation "etransitivity" open_constr(y) := + let R := match goal with |- ?R ?x ?z => constr:(R) end in + let x := match goal with |- ?R ?x ?z => constr:(x) end in + let z := match goal with |- ?R ?x ?z => constr:(z) end in + refine (@transitivity _ R _ x y z _ _). +Tactic Notation "etransitivity" := etransitivity _. +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation pr1 := projT1. +Notation pr2 := projT2. +Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. +Notation "x .2" := (projT2 x) (at level 3) : fibration_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Arguments idpath {A a} , [A] a. +Arguments paths_rect [A] a P f y p. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Delimit Scope path_scope with path. +Local Open Scope path_scope. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. +Instance transitive_paths {A} : Transitive (@paths A) | 0 := @concat A. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. +Notation "1" := idpath : path_scope. +Notation "p @ q" := (concat p q) (at level 20) : path_scope. +Notation "p ^" := (inverse p) (at level 3) : path_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. +Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): + p # (f x) = f y + := match p with idpath => idpath end. +Lemma transport_compose {A B} {x y : A} (P : B -> Type) (f : A -> B) + (p : x = y) (z : P (f x)) + : transport (fun x => P (f x)) p z = transport P (ap f p) z. +admit. +Defined. +Local Open Scope path_scope. +Generalizable Variables X A B C f g n. +Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (pq : {p : u.1 = v.1 & p # u.2 = v.2}) + : u = v + := match pq with + | existT p q => + match u, v return (forall p0 : (u.1 = v.1), (p0 # u.2 = v.2) -> (u=v)) with + | (x;y), (x';y') => fun p1 q1 => + match p1 in (_ = x'') return (forall y'', (p1 # y = y'') -> (x;y)=(x'';y'')) with + | idpath => fun y' q2 => + match q2 in (_ = y'') return (x;y) = (x;y'') with + | idpath => 1 + end + end y' q1 + end p q + end. +Definition path_sigma {A : Type} (P : A -> Type) (u v : sigT P) + (p : u.1 = v.1) (q : p # u.2 = v.2) + : u = v + := path_sigma_uncurried P u v (p;q). +Definition projT1_path `{P : A -> Type} {u v : sigT P} (p : u = v) + : u.1 = v.1 + := + ap (@projT1 _ _) p. +Notation "p ..1" := (projT1_path p) (at level 3) : fibration_scope. +Definition projT2_path `{P : A -> Type} {u v : sigT P} (p : u = v) + : p..1 # u.2 = v.2 + := (transport_compose P (@projT1 _ _) p u.2)^ + @ (@apD {x:A & P x} _ (@projT2 _ _) _ _ p). +Notation "p ..2" := (projT2_path p) (at level 3) : fibration_scope. +Definition eta_path_sigma_uncurried `{P : A -> Type} {u v : sigT P} + (p : u = v) + : path_sigma_uncurried _ _ _ (p..1; p..2) = p. +admit. +Defined. +Definition eta_path_sigma `{P : A -> Type} {u v : sigT P} (p : u = v) + : path_sigma _ _ _ (p..1) (p..2) = p + := eta_path_sigma_uncurried p. + +Definition path_path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (p q : u = v) + (rs : {r : p..1 = q..1 & transport (fun x => transport P x u.2 = v.2) r p..2 = q..2}) + : p = q. +Proof. + destruct rs, p, u. + etransitivity; [ | apply eta_path_sigma ]. + simpl in *. + induction p0. + admit. +Defined. diff --git a/test-suite/bugs/closed/bug_4782.v b/test-suite/bugs/closed/bug_4782.v new file mode 100644 index 0000000000..be17a96f15 --- /dev/null +++ b/test-suite/bugs/closed/bug_4782.v @@ -0,0 +1,25 @@ +(* About typing of with bindings *) + +Record r : Type := mk_r { type : Type; cond : type -> Prop }. + +Inductive p : Prop := consp : forall (e : r) (x : type e), cond e x -> p. + +Goal p. +Fail apply consp with (fun _ : bool => mk_r unit (fun x => True)) nil. +Abort. + +(* A simplification of an example from coquelicot, which was failing + at some time after a fix #4782 was committed. *) + +Record T := { dom : Type }. +Definition pairT A B := {| dom := (dom A * dom B)%type |}. +Class C (A:Type). +Parameter B:T. +Instance c (A:T) : C (dom A). +Instance cn : C (dom B). +Parameter F : forall A:T, C (dom A) -> forall x:dom A, x=x -> A = A. +Set Typeclasses Debug. +Goal forall (A:T) (x:dom A), pairT A A = pairT A A. +intros. +apply (F _ _) with (x,x). +Abort. diff --git a/test-suite/bugs/closed/bug_4785.v b/test-suite/bugs/closed/bug_4785.v new file mode 100644 index 0000000000..0d347b262d --- /dev/null +++ b/test-suite/bugs/closed/bug_4785.v @@ -0,0 +1,34 @@ +Require Coq.Lists.List Coq.Vectors.Vector. + +Module A. +Import Coq.Lists.List Coq.Vectors.Vector. +Import ListNotations. +Check [ ]%list : list _. +Import VectorNotations ListNotations. +Delimit Scope vector_scope with vector. +Check [ ]%vector : Vector.t _ _. +Check []%vector : Vector.t _ _. +Check [ ]%list : list _. +Check []%list : list _. + +Goal True. + idtac; []. (* Check that vector notations don't break the [ | .. | ] syntax of Ltac *) +Abort. + +Inductive mylist A := mynil | mycons (x : A) (xs : mylist A). +Delimit Scope mylist_scope with mylist. +Bind Scope mylist_scope with mylist. +Arguments mynil {_}, _. +Arguments mycons {_} _ _. +Notation " [ ] " := mynil (format "[ ]") : mylist_scope. +Notation " [ x ] " := (mycons x nil) : mylist_scope. +Notation " [ x ; y ; .. ; z ] " := (mycons x (mycons y .. (mycons z nil) ..)) : mylist_scope. + +Locate Module VectorNotations. +Import VectorDef.VectorNotations. + +Check []%vector : Vector.t _ _. +Check []%mylist : mylist _. +Check [ ]%mylist : mylist _. +Check [ ]%list : list _. +End A. diff --git a/test-suite/bugs/closed/bug_4787.v b/test-suite/bugs/closed/bug_4787.v new file mode 100644 index 0000000000..a1444a4f63 --- /dev/null +++ b/test-suite/bugs/closed/bug_4787.v @@ -0,0 +1,7 @@ +(* [Unset Bracketing Last Introduction Pattern] was not working *) + +Unset Bracketing Last Introduction Pattern. + +Goal forall T (x y : T * T), fst x = fst y /\ snd x = snd y -> x = y. +do 10 ((intros [] || intro); simpl); reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_4798.v b/test-suite/bugs/closed/bug_4798.v new file mode 100644 index 0000000000..41a1251ca5 --- /dev/null +++ b/test-suite/bugs/closed/bug_4798.v @@ -0,0 +1,3 @@ +Check match 2 with 0 => 0 | S n => n end. +Notation "|" := 1 (compat "8.7"). +Check match 2 with 0 => 0 | S n => n end. (* fails *) diff --git a/test-suite/bugs/closed/bug_4811.v b/test-suite/bugs/closed/bug_4811.v new file mode 100644 index 0000000000..fe6e65a0f0 --- /dev/null +++ b/test-suite/bugs/closed/bug_4811.v @@ -0,0 +1,1685 @@ +(* Test about a slowness of f_equal in 8.5pl1 *) + +(* Submitted by Jason Gross *) + +(* -*- mode: coq; coq-prog-args: ("-R" "src" "Crypto" "-R" "Bedrock" "Bedrock" "-R" "coqprime-8.5/Coqprime" "Coqprime" "-top" "GF255192") -*- *) +(* File reduced by coq-bug-finder from original input, then from 162 lines to 23 lines, then from 245 lines to 95 lines, then from 198 lines to 101 lines, then from 654 lines to 452 lines, then from 591 lines to 505 lines, then from 1770 lines to 580 lines, then from 2238 lines to 1715 lines, then from 1776 lines to 1738 lines, then from 1750 lines to 1679 lines, then from 1693 lines to 1679 lines *) +(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3 + coqtop version 8.5pl1 (April 2016) *) +Require Coq.ZArith.ZArith. + +Import Coq.ZArith.ZArith. + +Axiom F : Z -> Set. +Definition Let_In {A P} (x : A) (f : forall y : A, P y) + := let y := x in f y. +Local Open Scope Z_scope. +Definition modulus : Z := 2^255 - 19. +Axiom decode : list Z -> F modulus. +Goal forall x9 x8 x7 x6 x5 x4 x3 x2 x1 x0 y9 y8 y7 y6 y5 y4 y3 y2 y1 y0 : Z, + let Zmul := Z.mul in + let Zadd := Z.add in + let Zsub := Z.sub in + let Zpow_pos := Z.pow_pos in + @eq (F (Zsub (Zpow_pos (Zpos (xO xH)) (xI (xI (xI (xI (xI (xI (xI xH)))))))) (Zpos (xI (xI (xO (xO xH))))))) + (@decode + (@Let_In Z (fun _ : Z => list Z) + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (fun z : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (fun z0 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z0 (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (fun z1 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z1 (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8)) + (Zmul x4 y9))))) + (fun z2 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z2 (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (fun z3 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z3 (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4)) + (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (fun z4 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z4 (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) + (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) + (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) + (fun z5 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z5 (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) + (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (fun z6 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z6 (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) + (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) + (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) + (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) + (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (fun z7 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z7 (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) + (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) + (Zmul x1 y8)) (Zmul x0 y9))) + (fun z8 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Zmul (Zpos (xI (xI (xO (xO xH))))) (Z.shiftr z8 (Zpos (xI (xO (xO (xI xH))))))) + (Z.land z + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) + (fun z9 : Z => + @cons Z + (Z.land z9 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Zadd (Z.shiftr z9 (Zpos (xO (xI (xO (xI xH)))))) + (Z.land z0 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z1 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z2 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land z3 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z4 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land z5 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z6 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land z7 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z8 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@nil Z))))))))))))))))))))))) + (@decode + (@cons Z + (Z.land + (Zadd + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x9 y2) (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) + (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) + (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) + (Zmul x6 y7)) (Zmul x5 y8)) + (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) + (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) + (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) + (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) + (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) + (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) + (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) + (Zmul x0 y8)) (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) (Zmul x5 y4)) + (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9))) + (Zpos (xI (xO (xO (xI xH))))))) + (Z.land + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Zadd + (Z.shiftr + (Zadd + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul + (Zmul x5 y5) + (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul x9 y2) + (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) + (Zmul x3 y8)) + (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zmul x2 y0) + (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul (Zmul x9 y3) (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) + (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) + (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) + (Zmul x7 y6)) (Zmul x6 y7)) + (Zmul x5 y8)) (Zmul x4 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) + (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) + (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) + (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) + (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) + (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) + (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) + (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) + (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) + (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) + (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) + (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) + (Zmul x1 y8)) (Zmul x0 y9))) (Zpos (xI (xO (xO (xI xH))))))) + (Z.land + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Z.land + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) + (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) + (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8)) + (Zmul x4 y9))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) + (Zmul x6 y5)) (Zmul x5 y6)) (Zmul x4 y7)) + (Zmul x3 y8)) (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8)) + (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) + (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) + (Zmul x6 y5)) (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) + (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) + (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4)) + (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul (Zmul x9 y1) (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) + (Zmul x7 y4)) (Zmul x6 y5)) + (Zmul x5 y6)) (Zmul x4 y7)) + (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) + (Zmul x8 y4)) (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) + (Zmul x6 y7)) (Zmul x5 y8)) (Zmul x4 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) + (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) + (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) + (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) + (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x9 y2) (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) + (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) + (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) + (Zmul x6 y7)) (Zmul x5 y8)) + (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) + (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) + (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) + (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) + (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul + (Zmul x5 y5) + (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul + (Zmul x3 y7) + (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul x9 y2) + (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) + (Zmul x3 y8)) + (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zmul x2 y0) + (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y3) + (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) + (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) + (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) + (Zmul x7 y6)) (Zmul x6 y7)) + (Zmul x5 y8)) (Zmul x4 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) + (Zmul x8 y6)) (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) + (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) + (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) + (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) + (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) + (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) + (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5)) + (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) + (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH)))) + (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH)))) + (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) + (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul + (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul + (Zmul x5 y5) + (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul + (Zmul x3 y7) + (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul + (Zmul x1 y9) + (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul x9 y2) + (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) + (Zmul x3 y8)) + (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zmul x2 y0) + (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y3) + (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul + (Zmul x7 y5) + (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul + (Zmul x5 y7) + (Zpos (xO xH)))) + (Zmul x4 y8)) + (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) + (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x9 y4) (Zmul x8 y5)) + (Zmul x7 y6)) + (Zmul x6 y7)) + (Zmul x5 y8)) + (Zmul x4 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x4 y0) + (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) + (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) + (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) + (Zmul x2 y3)) (Zmul x1 y4)) + (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) + (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x6 y0) + (Zmul (Zmul x5 y1) (Zpos (xO xH)))) + (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) + (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) + (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) + (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5)) + (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) + (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH)))) + (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH)))) + (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) + (Zmul x0 y8)) + (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) + (Zmul x6 y3)) (Zmul x5 y4)) (Zmul x4 y5)) + (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@nil Z)))))))))))). + cbv beta zeta. + intros. + (timeout 1 (apply f_equal; reflexivity)) || fail 0 "too early". + Undo. + Time Timeout 1 f_equal. (* Finished transaction in 0. secs (0.3u,0.s) in 8.4 *) diff --git a/test-suite/bugs/closed/bug_4813.v b/test-suite/bugs/closed/bug_4813.v new file mode 100644 index 0000000000..5f8ea74c1a --- /dev/null +++ b/test-suite/bugs/closed/bug_4813.v @@ -0,0 +1,9 @@ +(* On the strength of "apply with" (see also #4782) *) + +Record ProverT := { Facts : Type }. +Record ProverT_correct (P : ProverT) := { Valid : Facts P -> Prop ; + Valid_weaken : Valid = Valid }. +Definition reflexivityValid (_ : unit) := True. +Definition reflexivityProver_correct : ProverT_correct {| Facts := unit |}. +Proof. + eapply Build_ProverT_correct with (Valid := reflexivityValid). diff --git a/test-suite/bugs/closed/bug_4816.v b/test-suite/bugs/closed/bug_4816.v new file mode 100644 index 0000000000..00a523842e --- /dev/null +++ b/test-suite/bugs/closed/bug_4816.v @@ -0,0 +1,29 @@ +Section foo. +Polymorphic Universes A B. +Fail Constraint A <= B. +End foo. +(* gives an anomaly Universe undefined *) + +Universes X Y. +Section Foo. + Polymorphic Universes Z W. + Polymorphic Constraint W < Z. + + Fail Definition bla := Type@{W}. + Polymorphic Definition bla := Type@{W}. + Section Bar. + Fail Constraint X <= Z. + End Bar. +End Foo. + +Require Coq.Classes.RelationClasses. + +Class PreOrder (A : Type) (r : A -> A -> Type) : Type := +{ refl : forall x, r x x }. + +Section qux. + Polymorphic Universes A. + Section bar. + Fail Context {A : Type@{A}} {rA : A -> A -> Prop} {PO : PreOrder A rA}. + End bar. +End qux. diff --git a/test-suite/bugs/closed/bug_4818.v b/test-suite/bugs/closed/bug_4818.v new file mode 100644 index 0000000000..7dc6e65725 --- /dev/null +++ b/test-suite/bugs/closed/bug_4818.v @@ -0,0 +1,24 @@ +(* -*- mode: coq; coq-prog-args: ("-R" "." "Prob" "-top" "Product") -*- *) +(* File reduced by coq-bug-finder from original input, then from 391 lines to 77 lines, then from 857 lines to 119 lines, then from 1584 lines to 126 lines, then from 362 lines to 135 lines, then from 149 lines to 135 lines *) +(* coqc version 8.5pl1 (June 2016) compiled on Jun 9 2016 17:27:17 with OCaml 4.02.3 + coqtop version 8.5pl1 (June 2016) *) +Set Universe Polymorphism. + +Inductive GCov (I : Type) : Type := | Foo : I -> GCov I. + +Section Product. + +Variables S IS : Type. +Variable locS : IS -> True. + +Goal GCov (IS * S) -> GCov IS. +intros X0. induction X0; intros. +destruct i. +specialize (locS i). +clear -locS. +destruct locS. Show Universes. +Admitted. + +(* +Anomaly: Universe Product.5189 undefined. Please report. +*) diff --git a/test-suite/bugs/closed/bug_4844.v b/test-suite/bugs/closed/bug_4844.v new file mode 100644 index 0000000000..f140939ccd --- /dev/null +++ b/test-suite/bugs/closed/bug_4844.v @@ -0,0 +1,47 @@ + +(* Bug report 4844 (and 4824): + The Haskell extraction was erroneously considering [Any] and + [()] as convertible ([Tunknown] an [Tdummy] internally). *) + +(* A value with inner logical parts. + Its extracted type will be [Sum () ()]. *) + +Definition semilogic : True + True := inl I. + +(* Higher-order record, whose projection [ST] isn't expressible + as an Haskell (or OCaml) type. Hence [ST] is extracted as the + unknown type [Any] in Haskell. *) + +Record SomeType := { ST : Type }. + +Definition SomeTrue := {| ST := True |}. + +(* A first version of the issue: + [abstrSum] is extracted as [Sum Any Any], so an unsafeCoerce + is required to cast [semilogic] into [abstrSum SomeTrue]. *) + +Definition abstrSum (t : SomeType) := ((ST t) + (ST t))%type. + +Definition semilogic' : abstrSum SomeTrue := semilogic. + +(* A deeper version of the issue. + In the previous example, the extraction could have reduced + [abstrSum SomeTrue] into [True+True], solving the issue. + It might do so in future versions. But if we put an inductive + in the way, a reduction isn't helpful. *) + +Inductive box (t : SomeType) := Box : ST t + ST t -> box t. + +Definition boxed_semilogic : box SomeTrue := + Box SomeTrue semilogic. + +Require Extraction. +Extraction Language Haskell. +Recursive Extraction semilogic' boxed_semilogic. +(* Warning! To fully check that this bug is still closed, + you should run ghc on the extracted code: + +Extraction "bug4844.hs" semilogic' boxed_semilogic. +ghc bug4844.hs + +*) diff --git a/test-suite/bugs/closed/bug_4852.v b/test-suite/bugs/closed/bug_4852.v new file mode 100644 index 0000000000..e2e00f05d3 --- /dev/null +++ b/test-suite/bugs/closed/bug_4852.v @@ -0,0 +1,53 @@ +(** BZ 4852 : unsatisfactory Extraction Implicit for a fixpoint defined via wf *) + +Require Import Coq.Lists.List. +Import ListNotations. +Require Import Omega. + +Definition wfi_lt := well_founded_induction_type Wf_nat.lt_wf. + +Tactic Notation "wfinduction" constr(term) "on" ne_hyp_list(Hs) "as" ident(H) := + let R := fresh in + let E := fresh in + remember term as R eqn:E; + revert E; revert Hs; + induction R as [R H] using wfi_lt; + intros; subst R. + +Hint Rewrite @app_comm_cons @app_assoc @app_length : app_rws. + +Ltac solve_nat := autorewrite with app_rws in *; cbn in *; omega. + +Notation "| x |" := (length x) (at level 11, no associativity, format "'|' x '|'"). + +Definition split_acc (ls : list nat) : forall acc1 acc2, + (|acc1| = |acc2| \/ |acc1| = S (|acc2|)) -> + { lss : list nat * list nat | + let '(ls1, ls2) := lss in |ls1++ls2| = |ls++acc1++acc2| /\ (|ls1| = |ls2| \/ |ls1| = S (|ls2|))}. +Proof. + induction ls as [|a ls IHls]. all:intros acc1 acc2 H. + { exists (acc1, acc2). cbn. intuition reflexivity. } + destruct (IHls (a::acc2) acc1) as [[ls1 ls2] (H1 & H2)]. 1:solve_nat. + exists (ls1, ls2). cbn. intuition solve_nat. +Defined. + +Definition join(ls : list nat) : { rls : list nat | |rls| = |ls| }. +Proof. + wfinduction (|ls|) on ls as IH. + case (split_acc ls [] []). 1:solve_nat. + intros (ls1 & ls2) (H1 & H2). + destruct ls2 as [|a ls2]. + - exists ls1. solve_nat. + - unshelve eelim (IH _ _ ls1 eq_refl). 1:solve_nat. intros rls1 H3. + unshelve eelim (IH _ _ ls2 eq_refl). 1:solve_nat. intros rls2 H4. + exists (a :: rls1 ++ rls2). solve_nat. +Defined. + +Require Import ExtrOcamlNatInt. +Extract Inlined Constant length => "List.length". +Extract Inlined Constant app => "List.append". + +Extraction Inline wfi_lt. +Extraction Implicit wfi_lt [1 3]. +Recursive Extraction join. (* was: Error: An implicit occurs after extraction *) +Extraction TestCompile join. diff --git a/test-suite/bugs/closed/bug_4858.v b/test-suite/bugs/closed/bug_4858.v new file mode 100644 index 0000000000..a2fa93832a --- /dev/null +++ b/test-suite/bugs/closed/bug_4858.v @@ -0,0 +1,7 @@ +Require Import Nsatz. +Goal True. +try nsatz_compute + (PEc 0%Z :: PEc (-1)%Z + :: PEpow (PEsub (PEX Z 2) (PEX Z 3)) 1 + :: PEsub (PEX Z 1) (PEX Z 1) :: nil). +Abort. diff --git a/test-suite/bugs/closed/bug_4859.v b/test-suite/bugs/closed/bug_4859.v new file mode 100644 index 0000000000..7be0bedcfc --- /dev/null +++ b/test-suite/bugs/closed/bug_4859.v @@ -0,0 +1,7 @@ +(* Not supported but check at least that it does not raise an anomaly *) + +Inductive Fin{n : nat} : Set := +| F1{i : nat}{e : n = S i} +| FS{i : nat}(f : @ Fin i){e : n = S i}. + +Fail Scheme Equality for Fin. diff --git a/test-suite/bugs/closed/bug_4863.v b/test-suite/bugs/closed/bug_4863.v new file mode 100644 index 0000000000..be2be5683e --- /dev/null +++ b/test-suite/bugs/closed/bug_4863.v @@ -0,0 +1,33 @@ +Require Import Classes.DecidableClass. + +Inductive Foo : Set := +| foo1 | foo2. + +Lemma Decidable_sumbool : forall P, {P}+{~P} -> Decidable P. +Proof. + intros P H. + refine (Build_Decidable _ (if H then true else false) _). + intuition congruence. +Qed. + +Hint Extern 100 (Decidable (?A = ?B)) => abstract (abstract (abstract (apply Decidable_sumbool; decide equality))) : typeclass_instances. + +Goal forall (a b : Foo), {a=b}+{a<>b}. +intros. +abstract (abstract (decide equality)). (*abstract works here*) +Qed. + +Check ltac:(abstract (exact I)) : True. + +Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). +intros. +split. typeclasses eauto. +typeclasses eauto. Qed. + +Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). +intros. +split. +refine _. +refine _. +Defined. +(*fails*) diff --git a/test-suite/bugs/closed/bug_4865.v b/test-suite/bugs/closed/bug_4865.v new file mode 100644 index 0000000000..4fd55d1c62 --- /dev/null +++ b/test-suite/bugs/closed/bug_4865.v @@ -0,0 +1,52 @@ +(* Check discharge of arguments scopes + other checks *) + +(* This is bug #4865 *) + +Notation "" := true : bool_scope. +Section A. + Check negb . + Global Arguments negb : clear scopes. + Fail Check negb . +End A. + +(* Check that no scope is re-computed *) +Fail Check negb . + +(* Another test about arguments scopes in sections *) + +Notation "0" := true. +Section B. + Variable x : nat. + Let T := nat -> nat. + Definition f y : T := fun z => x + y + z. + Fail Check f 1 0. (* 0 in nat, 0 in bool *) + Fail Check f 0 0. (* 0 in nat, 0 in bool *) + Check f 0 1. (* 0 and 1 in nat *) + Global Arguments f _%nat_scope _%nat_scope. + Check f 0 0. (* both 0 in nat *) +End B. + +(* Check that only the scope for the extra product on x is re-computed *) +Check f 0 0 0. (* All 0 in nat *) + +Section C. + Variable x : nat. + Let T := nat -> nat. + Definition g y : T := fun z => x + y + z. + Global Arguments g : clear scopes. + Check g 1. (* 1 in nat *) +End C. + +(* Check that only the scope for the extra product on x is re-computed *) +Check g 0. (* 0 in nat *) +Fail Check g 0 1 0. (* 2nd 0 in bool *) +Fail Check g 0 0 1. (* 2nd 0 in bool *) + +(* Another test on arguments scopes: checking scope for expanding arities *) +(* Not sure this is very useful, but why not *) + +Fixpoint arr n := match n with 0%nat => nat | S n => nat -> arr n end. +Fixpoint lam n : arr n := match n with 0%nat => 0%nat | S n => fun x => lam n end. +Notation "0" := true. +Arguments lam _%nat_scope _%nat_scope : extra scopes. +Check (lam 1 0). diff --git a/test-suite/bugs/closed/bug_4869.v b/test-suite/bugs/closed/bug_4869.v new file mode 100644 index 0000000000..ac5d7ea287 --- /dev/null +++ b/test-suite/bugs/closed/bug_4869.v @@ -0,0 +1,18 @@ +Universes i. + +Fail Constraint i < Set. +Fail Constraint i <= Set. +Fail Constraint i = Set. +Constraint Set <= i. +Constraint Set < i. +Fail Constraint i < j. (* undeclared j *) +Fail Constraint i < Type. (* anonymous *) + +Set Universe Polymorphism. + +Section Foo. + Universe j. + Constraint Set < j. + + Definition foo := Type@{j}. +End Foo. diff --git a/test-suite/bugs/closed/bug_4873.v b/test-suite/bugs/closed/bug_4873.v new file mode 100644 index 0000000000..39299883ad --- /dev/null +++ b/test-suite/bugs/closed/bug_4873.v @@ -0,0 +1,71 @@ +Require Import Coq.Classes.Morphisms. +Require Import Relation_Definitions. + +Fixpoint tuple' T n : Type := + match n with + | O => T + | S n' => (tuple' T n' * T)%type + end. + +Definition tuple T n : Type := + match n with + | O => unit + | S n' => tuple' T n' + end. + +Fixpoint to_list' {T} (n:nat) {struct n} : tuple' T n -> list T := + match n with + | 0 => fun x => (x::nil)%list + | S n' => fun xs : tuple' T (S n') => let (xs', x) := xs in (x :: to_list' n' xs')%list + end. + +Definition to_list {T} (n:nat) : tuple T n -> list T := + match n with + | 0 => fun _ => nil + | S n' => fun xs : tuple T (S n') => to_list' n' xs + end. + +Program Fixpoint from_list' {T} (y:T) (n:nat) (xs:list T) : length xs = n -> tuple' T n := + match n return _ with + | 0 => + match xs return (length xs = 0 -> tuple' T 0) with + | nil => fun _ => y + | _ => _ (* impossible *) + end + | S n' => + match xs return (length xs = S n' -> tuple' T (S n')) with + | cons x xs' => fun _ => (from_list' x n' xs' _, y) + | _ => _ (* impossible *) + end + end. +Goal True. + pose from_list'_obligation_3 as e. + repeat (let e' := fresh in + rename e into e'; + (pose (e' nat) as e || pose (e' 0) as e || pose (e' nil) as e || pose (e' eq_refl) as e); + subst e'). + progress hnf in e. + pose (eq_refl : e = eq_refl). + exact I. +Qed. + +Program Definition from_list {T} (n:nat) (xs:list T) : length xs = n -> tuple T n := +match n return _ with +| 0 => + match xs return (length xs = 0 -> tuple T 0) with + | nil => fun _ : 0 = 0 => tt + | _ => _ (* impossible *) + end +| S n' => + match xs return (length xs = S n' -> tuple T (S n')) with + | cons x xs' => fun _ => from_list' x n' xs' _ + | _ => _ (* impossible *) + end +end. + +Lemma to_list_from_list : forall {T} (n:nat) (xs:list T) pf, to_list n (from_list n xs pf) = xs. +Proof. + destruct xs; simpl; intros; subst; auto. + generalize dependent t. simpl in *. + induction xs; simpl in *; intros; congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_4877.v b/test-suite/bugs/closed/bug_4877.v new file mode 100644 index 0000000000..7d153d9828 --- /dev/null +++ b/test-suite/bugs/closed/bug_4877.v @@ -0,0 +1,12 @@ +Ltac induction_last := + let v := match goal with + | |- forall x y, _ = _ -> _ => 1 + | |- forall x y, _ -> _ = _ -> _ => 2 + | |- forall x y, _ -> _ -> _ = _ -> _ => 3 + end in + induction v. + +Goal forall n m : nat, True -> n = m -> m = n. + induction_last. + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_4880.v b/test-suite/bugs/closed/bug_4880.v new file mode 100644 index 0000000000..5569798d54 --- /dev/null +++ b/test-suite/bugs/closed/bug_4880.v @@ -0,0 +1,11 @@ +Require Import Coq.Reals.Reals Coq.nsatz.Nsatz. +Local Open Scope R. + +Goal forall x y : R, + x*x = y * y -> + x*x = -y * -y -> + x*(x*x) = 0 -> (* The associativity does not actually matter, *) + (x*x)*x = 0. (* just otherwise [assumption] would solve the goal. *) +Proof. + nsatz. +Qed. diff --git a/test-suite/bugs/closed/bug_4893.v b/test-suite/bugs/closed/bug_4893.v new file mode 100644 index 0000000000..9a35bcf954 --- /dev/null +++ b/test-suite/bugs/closed/bug_4893.v @@ -0,0 +1,4 @@ +Goal True. +evar (P: Prop). +assert (H : P); [|subst P]; [exact I|]. +let T := type of H in not_evar T. diff --git a/test-suite/bugs/closed/bug_4904.v b/test-suite/bugs/closed/bug_4904.v new file mode 100644 index 0000000000..a47c3b07a9 --- /dev/null +++ b/test-suite/bugs/closed/bug_4904.v @@ -0,0 +1,11 @@ +Module A. +Module B. +Notation mynat := nat. +Notation nat := nat. +End B. +End A. + +Print A.B.nat. (* Notation A.B.nat := nat *) +Import A. +Print B.mynat. +Print B.nat. diff --git a/test-suite/bugs/closed/bug_4932.v b/test-suite/bugs/closed/bug_4932.v new file mode 100644 index 0000000000..219d532ac6 --- /dev/null +++ b/test-suite/bugs/closed/bug_4932.v @@ -0,0 +1,44 @@ +(* Testing recursive notations with binders seen as terms *) + +Inductive ftele : Type := +| fb {T:Type} : T -> ftele +| fr {T} : (T -> ftele) -> ftele. + +Fixpoint args ftele : Type := + match ftele with + | fb _ => unit + | fr f => sigT (fun t => args (f t)) + end. + +Definition fpack := sigT args. +Definition pack fp fa : fpack := existT _ fp fa. + +Notation "'tele' x .. z := b" := + ( + (fun x => .. + (fun z => + pack + (fr (fun x => .. ( fr (fun z => fb b) ) .. ) ) + (existT _ x .. (existT _ z tt) .. ) + ) .. + ) + ) (at level 85, x binder, z binder). + +Check fun '((y,z):nat*nat) => pack (fr (fun '((y,z):nat*nat) => fb tt)) + (existT _ (y,z) tt). + +Example test := tele (t : Type) := tt. +Example test' := test nat. +Print test. + +Example test2 := tele (t : Type) (x:t) := tt. +Example test2' := test2 nat 0. +Print test2. + +Example test3 := tele (t : Type) (y:=0) (x:t) := tt. +Example test3' := test3 nat 0. +Print test3. + +Example test4 := tele (t : Type) '((y,z):nat*nat) (x:t) := tt. +Example test4' := test4 nat (1,2) 3. +Print test4. diff --git a/test-suite/bugs/closed/bug_4955.v b/test-suite/bugs/closed/bug_4955.v new file mode 100644 index 0000000000..cadc6e5da1 --- /dev/null +++ b/test-suite/bugs/closed/bug_4955.v @@ -0,0 +1,98 @@ +(* An example involving a first-order unification triggering a cyclic constraint *) + +Module A. +Notation "{ x : A | P }" := (sigT (fun x:A => P)). +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation "p @ q" := (eq_trans p q) (at level 20). +Notation "p ^" := (eq_sym p) (at level 3). +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) +: P y := + match p with eq_refl => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only +parsing). +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with eq_refl => eq_refl end. +Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): p # (f +x) = f y + := match p with eq_refl => eq_refl end. +Axiom transport_compose + : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f +x)), + transport (fun x => P (f x)) p z = transport P (ap f p) z. +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Delimit Scope functor_scope with functor. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) +(object_of d) }. +Arguments object_of {C%category D%category} f%functor c%object : rename, simpl +nomatch. +Arguments morphism_of [C%category] [D%category] f%functor [s%object d%object] +m%morphism : rename, simpl nomatch. +Section path_functor. + Variable C : PreCategory. + Variable D : PreCategory. + + Local Notation path_functor'_T F G + := { HO : object_of F = object_of G + | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) +(GO d)) + HO + (morphism_of F) + = morphism_of G } + (only parsing). + Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> +path_functor'_T F G + := fun H' + => (ap object_of H'; + (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H'). + +End path_functor. +End A. + +(* A variant of it with more axioms *) + +Module B. +Notation "{ x : A | P }" := (sigT (fun x:A => P)). +Notation "( x ; y )" := (existT _ x y). +Notation "p @ q" := (eq_trans p q) (at level 20). +Notation "p ^" := (eq_sym p) (at level 3). +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only +parsing). +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with eq_refl => eq_refl end. +Axiom apD : forall {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y), p # (f +x) = f y. +Axiom transport_compose + : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f +x)), + transport (fun x => P (f x)) p z = transport P (ap f p) z. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) +(object_of d) }. +Arguments object_of {C D} f c : rename, simpl nomatch. +Arguments morphism_of [C] [D] f [s d] m : rename, simpl nomatch. +Section path_functor. + Variable C D : PreCategory. + Local Notation path_functor'_T F G + := { HO : object_of F = object_of G + | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) +(GO d)) + HO + (morphism_of F) + = morphism_of G }. + Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> +path_functor'_T F G + := fun H' + => (ap object_of H'; + (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H'). + +End path_functor. +End B. diff --git a/test-suite/bugs/closed/bug_4957.v b/test-suite/bugs/closed/bug_4957.v new file mode 100644 index 0000000000..0efd87ac0d --- /dev/null +++ b/test-suite/bugs/closed/bug_4957.v @@ -0,0 +1,6 @@ +Ltac get_value H := eval cbv delta [H] in H. + +Goal True. +refine (let X := _ in _). +let e := get_value X in unify e Prop. +Abort. diff --git a/test-suite/bugs/closed/bug_4966.v b/test-suite/bugs/closed/bug_4966.v new file mode 100644 index 0000000000..bd93cdc858 --- /dev/null +++ b/test-suite/bugs/closed/bug_4966.v @@ -0,0 +1,10 @@ +(* Interpretation of auto as an argument of an ltac function (i.e. as an ident) was wrongly "auto with *" *) + +Axiom proof_admitted : False. +Hint Extern 0 => case proof_admitted : unused. +Ltac do_tac tac := tac. + +Goal False. + Set Ltac Profiling. + Fail solve [ do_tac auto ]. +Abort. diff --git a/test-suite/bugs/closed/bug_4969.v b/test-suite/bugs/closed/bug_4969.v new file mode 100644 index 0000000000..4dee41e221 --- /dev/null +++ b/test-suite/bugs/closed/bug_4969.v @@ -0,0 +1,11 @@ +Require Import Classes.Init. + +Class C A := c : A. +Instance nat_C : C nat := 0. +Instance bool_C : C bool := true. +Lemma silly {A} `{C A} : 0 = 0 -> c = c -> True. +Proof. auto. Qed. + +Goal True. + class_apply @silly; [reflexivity|]. + reflexivity. Fail Qed. diff --git a/test-suite/bugs/closed/bug_4970.v b/test-suite/bugs/closed/bug_4970.v new file mode 100644 index 0000000000..7a896582f5 --- /dev/null +++ b/test-suite/bugs/closed/bug_4970.v @@ -0,0 +1,3 @@ +(* Check "{{" is not confused with "{" in notations *) +Reserved Notation "x {{ y }}" (at level 40). +Notation "x {{ y }}" := (x y) (only parsing). diff --git a/test-suite/bugs/closed/bug_5011.v b/test-suite/bugs/closed/bug_5011.v new file mode 100644 index 0000000000..c3043ca5d1 --- /dev/null +++ b/test-suite/bugs/closed/bug_5011.v @@ -0,0 +1,2 @@ +Record decoder (n : nat) W := { decode : W -> nat }. +Existing Class decoder. diff --git a/test-suite/bugs/closed/bug_5012.v b/test-suite/bugs/closed/bug_5012.v new file mode 100644 index 0000000000..5326c0fbb1 --- /dev/null +++ b/test-suite/bugs/closed/bug_5012.v @@ -0,0 +1,17 @@ +Class Foo := { foo : Set }. + +Axiom admit : forall {T}, T. + +Global Instance Foo0 : Foo + := {| foo := admit |}. + +Global Instance Foo1 : Foo + := { foo := admit }. + +Existing Class Foo. + +Global Instance Foo2 : Foo + := { foo := admit }. (* Error: Unbound method name foo of class Foo. *) + +Set Warnings "+already-existing-class". +Fail Existing Class Foo. diff --git a/test-suite/bugs/closed/bug_5019.v b/test-suite/bugs/closed/bug_5019.v new file mode 100644 index 0000000000..7c973f88b5 --- /dev/null +++ b/test-suite/bugs/closed/bug_5019.v @@ -0,0 +1,5 @@ +Require Import Coq.ZArith.ZArith. +Goal forall (T0 : Z -> Type) (k : nat) d (P : T0 (Z.of_nat (S k)) -> Prop), P d. + clear; intros. + Timeout 1 zify. (* used to loop forever; should take < 0.01 s *) +Admitted. diff --git a/test-suite/bugs/closed/bug_5036.v b/test-suite/bugs/closed/bug_5036.v new file mode 100644 index 0000000000..83f1677455 --- /dev/null +++ b/test-suite/bugs/closed/bug_5036.v @@ -0,0 +1,10 @@ +Section foo. + Context (F : Type -> Type). + Context (admit : forall {T}, F T = True). + Hint Rewrite (fun T => @admit T). + Lemma bad : F False. + Proof. + autorewrite with core. + constructor. + Qed. +End foo. (* Anomaly: Universe Top.16 undefined. Please report. *) diff --git a/test-suite/bugs/closed/bug_5043.v b/test-suite/bugs/closed/bug_5043.v new file mode 100644 index 0000000000..4e6a0f878f --- /dev/null +++ b/test-suite/bugs/closed/bug_5043.v @@ -0,0 +1,8 @@ +Unset Keep Admitted Variables. + +Section a. + Context (x : Type). + Definition foo : Type. + Admitted. +End a. +Check foo : Type. diff --git a/test-suite/bugs/closed/bug_5045.v b/test-suite/bugs/closed/bug_5045.v new file mode 100644 index 0000000000..dc38738d8f --- /dev/null +++ b/test-suite/bugs/closed/bug_5045.v @@ -0,0 +1,3 @@ +Axiom silly : 1 = 1 -> nat -> nat. +Goal forall pf : 1 = 1, silly pf 0 = 0 -> True. + Fail generalize (@eq nat). diff --git a/test-suite/bugs/closed/bug_5065.v b/test-suite/bugs/closed/bug_5065.v new file mode 100644 index 0000000000..932fee8b3b --- /dev/null +++ b/test-suite/bugs/closed/bug_5065.v @@ -0,0 +1,6 @@ +Inductive foo := C1 : bar -> foo with bar := C2 : foo -> bar. + +Lemma L1 : foo -> True with L2 : bar -> True. +intros; clear L1 L2; abstract (exact I). +intros; exact I. +Qed. diff --git a/test-suite/bugs/closed/bug_5066.v b/test-suite/bugs/closed/bug_5066.v new file mode 100644 index 0000000000..eed7f0f3ff --- /dev/null +++ b/test-suite/bugs/closed/bug_5066.v @@ -0,0 +1,7 @@ +Require Import Vector. + +Fail Program Fixpoint vector_rev {A : Type} {n1 n2 : nat} (v1 : Vector.t A n1) (v2 : Vector.t A n2) : Vector.t A (n1+n2) := + match v1 with + | nil _ => v2 + | cons _ e n' sv => vector_rev sv (cons A e n2 v2) + end. diff --git a/test-suite/bugs/closed/bug_5077.v b/test-suite/bugs/closed/bug_5077.v new file mode 100644 index 0000000000..dee321c027 --- /dev/null +++ b/test-suite/bugs/closed/bug_5077.v @@ -0,0 +1,8 @@ +(* Testing robustness of typing for a fixpoint with evars in its type *) + +Inductive foo (n : nat) : Type := . +Definition foo_denote {n} (x : foo n) : Type := match x with end. + +Definition baz : forall n (x : foo n), foo_denote x. +refine (fix go n (x : foo n) : foo_denote x := _). +Abort. diff --git a/test-suite/bugs/closed/bug_5078.v b/test-suite/bugs/closed/bug_5078.v new file mode 100644 index 0000000000..ca73cbcc18 --- /dev/null +++ b/test-suite/bugs/closed/bug_5078.v @@ -0,0 +1,5 @@ +(* Test coercion from ident to evaluable reference *) +Tactic Notation "unfold_hyp" hyp(H) := cbv delta [H]. +Goal True -> Type. + intro H''. + Fail unfold_hyp H''. diff --git a/test-suite/bugs/closed/bug_5093.v b/test-suite/bugs/closed/bug_5093.v new file mode 100644 index 0000000000..3ded4dd304 --- /dev/null +++ b/test-suite/bugs/closed/bug_5093.v @@ -0,0 +1,11 @@ +Axiom P : nat -> Prop. +Axiom PS : forall n, P n -> P (S n). +Axiom P0 : P 0. + +Hint Resolve PS : foobar. +Hint Resolve P0 : foobar. + +Goal P 100. +Proof. +Fail typeclasses eauto 100 with foobar. +typeclasses eauto 101 with foobar. diff --git a/test-suite/bugs/closed/bug_5095.v b/test-suite/bugs/closed/bug_5095.v new file mode 100644 index 0000000000..b6f38e3e84 --- /dev/null +++ b/test-suite/bugs/closed/bug_5095.v @@ -0,0 +1,5 @@ +(* Checking let-in abstraction *) +Goal let x := Set in let y := x in True. + intros x y. + (* There used to have a too strict dependency test there *) + set (s := Set) in (value of x). diff --git a/test-suite/bugs/closed/bug_5096.v b/test-suite/bugs/closed/bug_5096.v new file mode 100644 index 0000000000..20a537ab3c --- /dev/null +++ b/test-suite/bugs/closed/bug_5096.v @@ -0,0 +1,219 @@ +Require Import Coq.FSets.FMapPositive Coq.PArith.BinPos Coq.Lists.List. + +Set Asymmetric Patterns. + +Notation eta x := (fst x, snd x). + +Inductive expr {var : Type} : Type := +| Const : expr +| LetIn : expr -> (var -> expr) -> expr. + +Definition Expr := forall var, @expr var. + +Fixpoint count_binders (e : @expr unit) : nat := +match e with +| LetIn _ eC => 1 + @count_binders (eC tt) +| _ => 0 +end. + +Definition CountBinders (e : Expr) : nat := count_binders (e _). + +Class Context (Name : Type) (var : Type) := + { ContextT : Type; + extendb : ContextT -> Name -> var -> ContextT; + empty : ContextT }. +Coercion ContextT : Context >-> Sortclass. +Arguments ContextT {_ _ _}, {_ _} _. +Arguments extendb {_ _ _} _ _ _. +Arguments empty {_ _ _}. + +Module Export Named. +Inductive expr Name : Type := +| Const : expr Name +| LetIn : Name -> expr Name -> expr Name -> expr Name. +End Named. + +Global Arguments Const {_}. +Global Arguments LetIn {_} _ _ _. + +Definition split_onames {Name : Type} (ls : list (option Name)) + : option (Name) * list (option Name) + := match ls with + | cons n ls' + => (n, ls') + | nil => (None, nil) + end. + +Section internal. + Context (InName OutName : Type) + {InContext : Context InName (OutName)} + {ReverseContext : Context OutName (InName)} + (InName_beq : InName -> InName -> bool). + + Fixpoint register_reassign (ctxi : InContext) (ctxr : ReverseContext) + (e : expr InName) (new_names : list (option OutName)) + : option (expr OutName) + := match e in Named.expr _ return option (expr _) with + | Const => Some Const + | LetIn n ex eC + => let '(n', new_names') := eta (split_onames new_names) in + match n', @register_reassign ctxi ctxr ex nil with + | Some n', Some x + => let ctxi := @extendb _ _ _ ctxi n n' in + let ctxr := @extendb _ _ _ ctxr n' n in + option_map (LetIn n' x) (@register_reassign ctxi ctxr eC new_names') + | None, Some x + => let ctxi := ctxi in + @register_reassign ctxi ctxr eC new_names' + | _, None => None + end + end. + +End internal. + +Global Instance pos_context (var : Type) : Context positive var + := { ContextT := PositiveMap.t var; + extendb ctx key v := PositiveMap.add key v ctx; + empty := PositiveMap.empty _ }. + +Global Arguments register_reassign {_ _ _ _} ctxi ctxr e _. + +Section language5. + Context (Name : Type). + + Local Notation expr := (@Top.expr Name). + Local Notation nexpr := (@Named.expr Name). + + Fixpoint ocompile (e : expr) (ls : list (option Name)) {struct e} + : option (nexpr) + := match e in @Top.expr _ return option (nexpr) with + | Top.Const => Some Named.Const + | Top.LetIn ex eC + => match @ocompile ex nil, split_onames ls with + | Some x, (Some n, ls')%core + => option_map (fun C => Named.LetIn n x C) (@ocompile (eC n) ls') + | _, _ => None + end + end. + + Definition compile (e : expr) (ls : list Name) := @ocompile e (List.map (@Some _) ls). +End language5. + +Global Arguments compile {_} e ls. + +Fixpoint merge_liveness (ls1 ls2 : list unit) := + match ls1, ls2 with + | cons x xs, cons y ys => cons tt (@merge_liveness xs ys) + | nil, ls | ls, nil => ls + end. + +Section internal1. + Context (Name : Type) + (OutName : Type) + {Context : Context Name (list unit)}. + + Definition compute_livenessf_step + (compute_livenessf : forall (ctx : Context) (e : expr Name) (prefix : list unit), list unit) + (ctx : Context) + (e : expr Name) (prefix : list unit) + : list unit + := match e with + | Const => prefix + | LetIn n ex eC + => let lx := @compute_livenessf ctx ex prefix in + let lx := merge_liveness lx (prefix ++ repeat tt 1) in + let ctx := @extendb _ _ _ ctx n (lx) in + @compute_livenessf ctx eC (prefix ++ repeat tt 1) + end. + + Fixpoint compute_liveness ctx e prefix + := @compute_livenessf_step (@compute_liveness) ctx e prefix. + + Fixpoint insert_dead_names_gen def (ls : list unit) (lsn : list OutName) + : list (option OutName) + := match ls with + | nil => nil + | cons live xs + => match lsn with + | cons n lsn' => Some n :: @insert_dead_names_gen def xs lsn' + | nil => def :: @insert_dead_names_gen def xs nil + end + end. + Definition insert_dead_names def (e : expr Name) + := insert_dead_names_gen def (compute_liveness empty e nil). +End internal1. + +Global Arguments insert_dead_names {_ _ _} def e lsn. + +Definition Let_In {A P} (x : A) (f : forall a : A, P a) : P x := let y := x in f y. + +Section language7. + Context {Context : Context unit (positive)}. + + Local Notation nexpr := (@Named.expr unit). + + Definition CompileAndEliminateDeadCode (e : Expr) (ls : list unit) + : option (nexpr) + := let e := compile (Name:=positive) (e _) (List.map Pos.of_nat (seq 1 (CountBinders e))) in + match e with + | Some e => Let_In (insert_dead_names None e ls) (* help vm_compute by factoring this out *) + (fun names => register_reassign empty empty e names) + | None => None + end. +End language7. + +Global Arguments CompileAndEliminateDeadCode {_} e ls. + +Definition ContextOn {Name1 Name2} f {var} (Ctx : Context Name1 var) : Context Name2 var + := {| ContextT := Ctx; + extendb ctx n v := extendb ctx (f n) v; + empty := empty |}. + +Definition Register := Datatypes.unit. + +Global Instance RegisterContext {var : Type} : Context Register var + := ContextOn (fun _ => 1%positive) (pos_context var). + +Definition syntax := Named.expr Register. + +Definition AssembleSyntax e ls (res := CompileAndEliminateDeadCode e ls) + := match res return match res with None => _ | _ => _ end with + | Some v => v + | None => I + end. + +Definition dummy_registers (n : nat) : list Register + := List.map (fun _ => tt) (seq 0 n). +Definition DefaultRegisters (e : Expr) : list Register + := dummy_registers (CountBinders e). + +Definition DefaultAssembleSyntax e := @AssembleSyntax e (DefaultRegisters e). + +Notation "'slet' x := A 'in' b" := (Top.LetIn A (fun x => b)) (at level 200, b at level 200). +Notation "#[ var ]#" := (@Top.Const var). + +Definition compiled_syntax : Expr := fun (var : Type) => +( + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + @Top.Const var). + +Definition v := + Eval cbv [compiled_syntax] in (DefaultAssembleSyntax (compiled_syntax)). + +Timeout 2 Eval vm_compute in v. diff --git a/test-suite/bugs/closed/bug_5097.v b/test-suite/bugs/closed/bug_5097.v new file mode 100644 index 0000000000..37b239cf61 --- /dev/null +++ b/test-suite/bugs/closed/bug_5097.v @@ -0,0 +1,7 @@ +(* Tracing existing evars along the weakening rule ("clear") *) +Goal forall y, exists x, x=0->x=y. +intros. +eexists ?[x]. +intros. +let x:=constr:(ltac:(clear y; exact 0)) in idtac x. +Abort. diff --git a/test-suite/bugs/closed/bug_5123.v b/test-suite/bugs/closed/bug_5123.v new file mode 100644 index 0000000000..17231bffcf --- /dev/null +++ b/test-suite/bugs/closed/bug_5123.v @@ -0,0 +1,33 @@ +(* IN 8.5pl2 and 8.6 (4da2131), the following shows different typeclass resolution behaviors following an unshelve tactical vs. an Unshelve command: *) + +(*Pose an open constr to prevent immediate typeclass resolution in holes:*) +Tactic Notation "opose" open_constr(x) "as" ident(H) := pose x as H. + +Inductive vect A : nat -> Type := +| vnil : vect A 0 +| vcons : forall (h:A) (n:nat), vect A n -> vect A (S n). + +Class Eqdec A := eqdec : forall a b : A, {a=b}+{a<>b}. + +Require Bool. + +Instance Bool_eqdec : Eqdec bool := Bool.bool_dec. + +Context `{vect_sigT_eqdec : forall A : Type, Eqdec A -> Eqdec {a : nat & vect A a}}. + +Typeclasses eauto := debug. + +Goal True. + unshelve opose (@vect_sigT_eqdec _ _ _ _) as H. + all:cycle 2. + eapply existT. (*BUG: Why does this do typeclass resolution in the evar?*) + Focus 5. +Abort. + +Goal True. + opose (@vect_sigT_eqdec _ _ _ _) as H. + Unshelve. + all:cycle 3. + eapply existT. (*This does no typeclass resultion, which is correct.*) + Focus 5. +Abort. diff --git a/test-suite/bugs/closed/bug_5127.v b/test-suite/bugs/closed/bug_5127.v new file mode 100644 index 0000000000..831e8fb507 --- /dev/null +++ b/test-suite/bugs/closed/bug_5127.v @@ -0,0 +1,15 @@ +Fixpoint arrow (n: nat) := + match n with + | S n => bool -> arrow n + | O => bool + end. + +Fixpoint apply (n : nat) : arrow n -> bool := + match n return arrow n -> bool with + | S n => fun f => apply _ (f true) + | O => fun x => x + end. + +Axiom f : arrow 10000. +Definition v : bool := Eval compute in apply _ f. +Definition w : bool := Eval vm_compute in v. diff --git a/test-suite/bugs/closed/bug_5145.v b/test-suite/bugs/closed/bug_5145.v new file mode 100644 index 0000000000..0533d21e0c --- /dev/null +++ b/test-suite/bugs/closed/bug_5145.v @@ -0,0 +1,10 @@ +Class instructions := + { + W : Type; + ldi : nat -> W + }. + +Fail Definition foo := + let y2 := ldi 0 in + let '(CF, _) := (true, 0) in + y2. diff --git a/test-suite/bugs/closed/bug_5149.v b/test-suite/bugs/closed/bug_5149.v new file mode 100644 index 0000000000..ae32217057 --- /dev/null +++ b/test-suite/bugs/closed/bug_5149.v @@ -0,0 +1,46 @@ +Goal forall x x' : nat, x = x' -> S x = S x -> exists y, S y = S x. +intros. +eexists. +rewrite <- H. +eassumption. +Qed. + +Goal forall (base_type_code : Type) (t : base_type_code) (flat_type : Type) + (t' : flat_type) (exprf interp_flat_type0 interp_flat_type1 : +flat_type -> Type) + (v v' : interp_flat_type1 t'), + v = v' -> + forall (interpf : forall t0 : flat_type, exprf t0 -> interp_flat_type1 t0) + (SmartVarVar : forall t0 : flat_type, interp_flat_type1 t0 -> +interp_flat_type0 t0) + (Tbase : base_type_code -> flat_type) (x : exprf (Tbase t)) + (x' : interp_flat_type1 (Tbase t)) (T : Type) + (flatten_binding_list : forall t0 : flat_type, + interp_flat_type0 t0 -> interp_flat_type1 t0 -> list T) + (P : T -> list T -> Prop) (prod : Type -> Type -> Type) + (s : forall x0 : base_type_code, prod (exprf (Tbase x0)) +(interp_flat_type1 (Tbase x0)) -> T) + (pair : forall A B : Type, A -> B -> prod A B), + P (s t (pair (exprf (Tbase t)) (interp_flat_type1 (Tbase t)) x x')) + (flatten_binding_list t' (SmartVarVar t' v') v) -> + (forall (t0 : base_type_code) (t'0 : flat_type) (v0 : interp_flat_type1 +t'0) + (x0 : exprf (Tbase t0)) (x'0 : interp_flat_type1 (Tbase t0)), + P (s t0 (pair (exprf (Tbase t0)) (interp_flat_type1 (Tbase t0)) x0 +x'0)) + (flatten_binding_list t'0 (SmartVarVar t'0 v0) v0) -> interpf +(Tbase t0) x0 = x'0) -> + interpf (Tbase t) x = x'. +Proof. + intros ?????????????????????? interpf_SmartVarVar. + solve [ unshelve (subst; eapply interpf_SmartVarVar; eassumption) ] || fail +"too early". + Undo. + (** Implicitely at the dot. The first fails because unshelve adds a goal, and solve hence fails. The second has an ambiant unification problem that is solved after solve *) + Fail solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption) ]. + solve [eapply interpf_SmartVarVar; subst; eassumption]. + Undo. + Unset Solve Unification Constraints. + (* User control of when constraints are solved *) + solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption); solve_constraints ]. +Qed. diff --git a/test-suite/bugs/closed/bug_5153.v b/test-suite/bugs/closed/bug_5153.v new file mode 100644 index 0000000000..be6407b5fa --- /dev/null +++ b/test-suite/bugs/closed/bug_5153.v @@ -0,0 +1,8 @@ +(* An example where it does not hurt having more type-classes resolution *) +Class some_type := { Ty : Type }. +Instance: some_type := { Ty := nat }. +Arguments Ty : clear implicits. +Goal forall (H : forall t : some_type, @Ty t -> False) (H' : False -> 1 = 2), 1 = 2. +Proof. +intros H H'. +specialize (H' (@H _ O)). (* was failing *) diff --git a/test-suite/bugs/closed/bug_5161.v b/test-suite/bugs/closed/bug_5161.v new file mode 100644 index 0000000000..d28303b8ab --- /dev/null +++ b/test-suite/bugs/closed/bug_5161.v @@ -0,0 +1,27 @@ +(* Check that the presence of binders with type annotation do not + prevent the recursive binder part to be found *) + +From Coq Require Import Utf8. + +Delimit Scope C_scope with C. +Global Open Scope C_scope. + +Delimit Scope uPred_scope with I. + +Definition FORALL {T : Type} (f : T → Prop) : Prop := ∀ x, f x. + +Notation "∀ x .. y , P" := + (FORALL (λ x, .. (FORALL (λ y, P)) ..)%I) + (at level 200, x binder, y binder, right associativity) : uPred_scope. +Infix "∧" := and : uPred_scope. + +(* The next command fails with + In recursive notation with binders, Φ is expected to come without type. + I would expect this notation to work fine, since the ∀ does support + type annotation. +*) +Notation "'{{{' P } } } e {{{ x .. y ; pat , Q } } }" := + (∀ Φ : _ → _, + (∀ x, .. (∀ y, Q ∧ Φ pat) .. ))%I + (at level 20, x closed binder, y closed binder, + format "{{{ P } } } e {{{ x .. y ; pat , Q } } }") : uPred_scope. diff --git a/test-suite/bugs/closed/bug_5177.v b/test-suite/bugs/closed/bug_5177.v new file mode 100644 index 0000000000..7c8af1e46e --- /dev/null +++ b/test-suite/bugs/closed/bug_5177.v @@ -0,0 +1,22 @@ +(* Bug 5177 https://coq.inria.fr/bug/5177 : + Extraction and module type containing application and "with" *) + +Module Type T. + Parameter t: Type. +End T. + +Module Type A (MT: T). + Parameter t1: Type. + Parameter t2: Type. + Parameter bar: MT.t -> t1 -> t2. +End A. + +Module MakeA(MT: T): A MT with Definition t1 := nat. + Definition t1 := nat. + Definition t2 := nat. + Definition bar (m: MT.t) (x:t1) := x. +End MakeA. + +Require Extraction. +Recursive Extraction MakeA. +Extraction TestCompile MakeA. diff --git a/test-suite/bugs/closed/bug_5180.v b/test-suite/bugs/closed/bug_5180.v new file mode 100644 index 0000000000..05603a048c --- /dev/null +++ b/test-suite/bugs/closed/bug_5180.v @@ -0,0 +1,64 @@ +Universes a b c ω ω'. +Definition Typeω := Type@{ω}. +Definition Type2 : Typeω := Type@{c}. +Definition Type1 : Type2 := Type@{b}. +Definition Type0 : Type1 := Type@{a}. + +Set Universe Polymorphism. +Set Printing Universes. + +Definition Typei' (n : nat) + := match n return Type@{ω'} with + | 0 => Type0 + | 1 => Type1 + | 2 => Type2 + | _ => Typeω + end. +Definition TypeOfTypei' {n} (x : Typei' n) : Type@{ω'} + := match n return Typei' n -> Type@{ω'} with + | 0 | 1 | 2 | _ => fun x => x + end x. +Definition Typei (n : nat) : Typei' (S n) + := match n return Typei' (S n) with + | 0 => Type0 + | 1 => Type1 + | _ => Type2 + end. +Definition TypeOfTypei {n} (x : TypeOfTypei' (Typei n)) : Type@{ω'} + := match n return TypeOfTypei' (Typei n) -> Type@{ω'} with + | 0 | 1 | _ => fun x => x + end x. +Check Typei 0 : Typei 1. +Check Typei 1 : Typei 2. + +Definition lift' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) + := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with + | 0 | 1 | 2 | _ => fun x => (x : Type) + end. +Definition lift'' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) + := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with + | 0 | 1 | 2 | _ => fun x => x + end. (* The command has indeed failed with message: +In environment +n : nat +x : TypeOfTypei' (Typei 0) +The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type + "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because a < b). + *) +Check (fun x : TypeOfTypei' (Typei 0) => TypeOfTypei' (Typei 1)). + +Definition lift''' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)). + refine match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with + | 0 | 1 | 2 | _ => fun x => _ + end. + exact x. + Undo. + (* The command has indeed failed with message: +In environment +n : nat +x : TypeOfTypei' (Typei 0) +The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type + "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because a < b). + *) + all:compute in *. + all:exact x. diff --git a/test-suite/bugs/closed/bug_5181.v b/test-suite/bugs/closed/bug_5181.v new file mode 100644 index 0000000000..89f54e1bec --- /dev/null +++ b/test-suite/bugs/closed/bug_5181.v @@ -0,0 +1,2 @@ +Definition foo (x y : nat) := x. +Fail Arguments foo {_} : assert. diff --git a/test-suite/bugs/closed/bug_5188.v b/test-suite/bugs/closed/bug_5188.v new file mode 100644 index 0000000000..e29ebfb4ec --- /dev/null +++ b/test-suite/bugs/closed/bug_5188.v @@ -0,0 +1,5 @@ +Set Printing All. +Axiom relation : forall (T : Type), Set. +Axiom T : forall A (R : relation A), Set. +Set Printing Universes. +Parameter (A:_) (R:_) (e:@T A R). diff --git a/test-suite/bugs/closed/bug_5193.v b/test-suite/bugs/closed/bug_5193.v new file mode 100644 index 0000000000..cc8739afe6 --- /dev/null +++ b/test-suite/bugs/closed/bug_5193.v @@ -0,0 +1,14 @@ +Class Eqdec A := eqdec : forall a b : A, {a=b}+{a<>b}. + +Typeclasses eauto := debug. +Set Typeclasses Debug Verbosity 2. + +Inductive Finx(n : nat) : Set := +| Fx1(i : nat)(e : n = S i) +| FxS(i : nat)(f : Finx i)(e : n = S i). + +Context `{Finx_eqdec : forall n, Eqdec (Finx n)}. + +Goal {x : Type & Eqdec x}. + eexists. + try typeclasses eauto 1 with typeclass_instances. diff --git a/test-suite/bugs/closed/bug_5198.v b/test-suite/bugs/closed/bug_5198.v new file mode 100644 index 0000000000..5d4409f89b --- /dev/null +++ b/test-suite/bugs/closed/bug_5198.v @@ -0,0 +1,39 @@ +(* -*- mode: coq; coq-prog-args: ("-boot" "-nois") -*- *) +(* File reduced by coq-bug-finder from original input, then from 286 lines to +27 lines, then from 224 lines to 53 lines, then from 218 lines to 56 lines, +then from 269 lines to 180 lines, then from 132 lines to 48 lines, then from +253 lines to 65 lines, then from 79 lines to 65 lines *) +(* coqc version 8.6.0 (November 2016) compiled on Nov 12 2016 14:43:52 with +OCaml 4.02.3 + coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-v8.6,v8.6 +(7e992fa784ee6fa48af8a2e461385c094985587d) *) +Axiom admit : forall {T}, T. +Set Printing Implicit. +Inductive nat := O | S (_ : nat). +Axiom f : forall (_ _ : nat), nat. +Class ZLikeOps (e : nat) + := { LargeT : Type ; SmallT : Type ; CarryAdd : forall (_ _ : LargeT), LargeT +}. +Class BarrettParameters := + { b : nat ; k : nat ; ops : ZLikeOps (f b k) }. +Axiom barrett_reduce_function_bundled : forall {params : BarrettParameters} + (_ : @LargeT _ (@ops params)), + @SmallT _ (@ops params). + +Global Instance ZZLikeOps e : ZLikeOps (f (S O) e) + := { LargeT := nat ; SmallT := nat ; CarryAdd x y := y }. +Definition SRep := nat. +Local Instance x86_25519_Barrett : BarrettParameters + := { b := S O ; k := O ; ops := ZZLikeOps O }. +Definition SRepAdd : forall (_ _ : SRep), SRep + := let v := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)) in + v. +Definition SRepAdd' : forall (_ _ : SRep), SRep + := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)). +(* Error: +In environment +x : SRep +y : SRep +The term "x" has type "SRep" while it is expected to have type + "@LargeT ?e ?ZLikeOps". + *) diff --git a/test-suite/bugs/closed/bug_5203.v b/test-suite/bugs/closed/bug_5203.v new file mode 100644 index 0000000000..b0161cc530 --- /dev/null +++ b/test-suite/bugs/closed/bug_5203.v @@ -0,0 +1,4 @@ +Goal True. + Typeclasses eauto := debug. + Fail solve [ typeclasses eauto ]. + Fail typeclasses eauto. diff --git a/test-suite/bugs/closed/bug_5205.v b/test-suite/bugs/closed/bug_5205.v new file mode 100644 index 0000000000..406f37a4b1 --- /dev/null +++ b/test-suite/bugs/closed/bug_5205.v @@ -0,0 +1,6 @@ +Definition foo (n : nat) (m : nat) : nat := m. + +Arguments foo {_} _, _ _. + +Check foo 1 1. +Check foo (n:=1) 1. diff --git a/test-suite/bugs/closed/bug_5208.v b/test-suite/bugs/closed/bug_5208.v new file mode 100644 index 0000000000..b7a684a27c --- /dev/null +++ b/test-suite/bugs/closed/bug_5208.v @@ -0,0 +1,222 @@ +Require Import Program. + +Require Import Coq.Strings.String. +Require Import Coq.Strings.Ascii. +Require Import Coq.Numbers.BinNums. + +Set Implicit Arguments. +Set Strict Implicit. +Set Universe Polymorphism. +Set Printing Universes. + +Local Open Scope positive. + +Definition field : Type := positive. + +Section poly. + Universe U. + + Inductive fields : Type := + | pm_Leaf : fields + | pm_Branch : fields -> option Type@{U} -> fields -> fields. + + Definition fields_left (f : fields) : fields := + match f with + | pm_Leaf => pm_Leaf + | pm_Branch l _ _ => l + end. + + Definition fields_right (f : fields) : fields := + match f with + | pm_Leaf => pm_Leaf + | pm_Branch _ _ r => r + end. + + Definition fields_here (f : fields) : option Type@{U} := + match f with + | pm_Leaf => None + | pm_Branch _ s _ => s + end. + + Fixpoint fields_get (p : field) (m : fields) {struct p} : option Type@{U} := + match p with + | xH => match m with + | pm_Leaf => None + | pm_Branch _ x _ => x + end + | xO p' => fields_get p' match m with + | pm_Leaf => pm_Leaf + | pm_Branch L _ _ => L + end + | xI p' => fields_get p' match m with + | pm_Leaf => pm_Leaf + | pm_Branch _ _ R => R + end + end. + + Definition fields_leaf : fields := pm_Leaf. + + Inductive member (val : Type@{U}) : fields -> Type := + | pmm_H : forall L R, member val (pm_Branch L (Some val) R) + | pmm_L : forall (V : option Type@{U}) L R, member val L -> member val (pm_Branch L V R) + | pmm_R : forall (V : option Type@{U}) L R, member val R -> member val (pm_Branch L V R). + Arguments pmm_H {_ _ _}. + Arguments pmm_L {_ _ _ _} _. + Arguments pmm_R {_ _ _ _} _. + + Fixpoint get_member (val : Type@{U}) p {struct p} + : forall m, fields_get p m = @Some Type@{U} val -> member val m := + match p as p return forall m, fields_get p m = @Some Type@{U} val -> member@{U} val m with + | xH => fun m => + match m as m return fields_get xH m = @Some Type@{U} val -> member@{U} val m with + | pm_Leaf => fun pf : None = @Some Type@{U} _ => + match pf in _ = Z return match Z with + | Some _ => _ + | None => unit + end + with + | eq_refl => tt + end + | pm_Branch _ None _ => fun pf : None = @Some Type@{U} _ => + match pf in _ = Z return match Z with + | Some _ => _ + | None => unit + end + with + | eq_refl => tt + end + | pm_Branch _ (Some x) _ => fun pf : @Some Type@{U} x = @Some Type@{U} val => + match eq_sym pf in _ = Z return member@{U} val (pm_Branch _ Z _) with + | eq_refl => pmm_H + end + end + | xO p' => fun m => + match m as m return fields_get (xO p') m = @Some Type@{U} val -> member@{U} val m with + | pm_Leaf => fun pf : fields_get p' pm_Leaf = @Some Type@{U} val => + @get_member _ p' pm_Leaf pf + | pm_Branch l _ _ => fun pf : fields_get p' l = @Some Type@{U} val => + @pmm_L _ _ _ _ (@get_member _ p' l pf) + end + | xI p' => fun m => + match m as m return fields_get (xI p') m = @Some Type@{U} val -> member@{U} val m with + | pm_Leaf => fun pf : fields_get p' pm_Leaf = @Some Type@{U} val => + @get_member _ p' pm_Leaf pf + | pm_Branch l _ r => fun pf : fields_get p' r = @Some Type@{U} val => + @pmm_R _ _ _ _ (@get_member _ p' r pf) + end + end. + + Inductive record : fields -> Type := + | pr_Leaf : record pm_Leaf + | pr_Branch : forall L R (V : option Type@{U}), + record L -> + match V return Type@{U} with + | None => unit + | Some t => t + end -> + record R -> + record (pm_Branch L V R). + + + Definition record_left {L} {V : option Type@{U}} {R} + (r : record (pm_Branch L V R)) : record L := + match r in record z + return match z with + | pm_Branch L _ _ => record L + | _ => unit + end + with + | pr_Branch _ l _ _ => l + | pr_Leaf => tt + end. +Set Printing All. + Definition record_at {L} {V : option Type@{U}} {R} (r : record (pm_Branch L V R)) + : match V return Type@{U} with + | None => unit + | Some t => t + end := + match r in record z + return match z (* return ?X *) with + | pm_Branch _ V _ => match V return Type@{U} with + | None => unit + | Some t => t + end + | _ => unit + end + with + | pr_Branch _ _ v _ => v + | pr_Leaf => tt + end. + + Definition record_here {L : fields} (v : Type@{U}) {R : fields} + (r : record (pm_Branch L (@Some Type@{U} v) R)) : v := + match r in record z + return match z return Type@{U} with + | pm_Branch _ (Some v) _ => v + | _ => unit + end + with + | pr_Branch _ _ v _ => v + | pr_Leaf => tt + end. + + Definition record_right {L V R} (r : record (pm_Branch L V R)) : record R := + match r in record z return match z with + | pm_Branch _ _ R => record R + | _ => unit + end + with + | pr_Branch _ _ _ r => r + | pr_Leaf => tt + end. + + Fixpoint record_get {val : Type@{U}} {pm : fields} (m : member val pm) : record pm -> val := + match m in member _ pm return record pm -> val with + | pmm_H => fun r => record_here r + | pmm_L m' => fun r => record_get m' (record_left r) + | pmm_R m' => fun r => record_get m' (record_right r) + end. + + Fixpoint record_set {val : Type@{U}} {pm : fields} (m : member val pm) (x : val) {struct m} + : record pm -> record pm := + match m in member _ pm return record pm -> record pm with + | pmm_H => fun r => + pr_Branch (Some _) + (record_left r) + x + (record_right r) + | pmm_L m' => fun r => + pr_Branch _ + (record_set m' x (record_left r)) + (record_at r) + (record_right r) + | pmm_R m' => fun r => + pr_Branch _ (record_left r) + (record_at r) + (record_set m' x (record_right r)) + end. +End poly. +Axiom cheat : forall {A}, A. +Lemma record_get_record_set_different: + forall (T: Type) (vars: fields) + (pmr pmw: member T vars) + (diff: pmr <> pmw) + (r: record vars) (val: T), + record_get pmr (record_set pmw val r) = record_get pmr r. +Proof. + intros. + revert pmr diff r val. + induction pmw; simpl; intros. + - dependent destruction pmr. + + congruence. + + auto. + + auto. + - dependent destruction pmr. + + auto. + + simpl. apply IHpmw. congruence. + + auto. + - dependent destruction pmr. + + auto. + + auto. + + simpl. apply IHpmw. congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_5215.v b/test-suite/bugs/closed/bug_5215.v new file mode 100644 index 0000000000..ecf5291596 --- /dev/null +++ b/test-suite/bugs/closed/bug_5215.v @@ -0,0 +1,286 @@ +Require Import Coq.Logic.FunctionalExtensionality. +Require Import Coq.Program.Tactics. + +Global Set Primitive Projections. + +Global Set Universe Polymorphism. + +Global Unset Universe Minimization ToSet. + +Class Category : Type := +{ + Obj : Type; + Hom : Obj -> Obj -> Type; + compose : forall {a b c : Obj}, (Hom a b) -> (Hom b c) -> (Hom a c); + id : forall {a : Obj}, Hom a a; +}. + +Arguments Obj {_}, _. +Arguments id {_ _}, {_} _, _ _. +Arguments Hom {_} _ _, _ _ _. +Arguments compose {_} {_ _ _} _ _, _ {_ _ _} _ _, _ _ _ _ _ _. + +Coercion Obj : Category >-> Sortclass. + +Definition Opposite (C : Category) : Category := +{| + + Obj := Obj C; + Hom := fun a b => Hom b a; + compose := + fun a b c (f : Hom b a) (g : Hom c b) => compose C c b a g f; + id := fun c => id C c; +|}. + +Record Functor (C C' : Category) : Type := +{ + FO : C -> C'; + FA : forall {a b}, Hom a b -> Hom (FO a) (FO b); +}. + +Arguments FO {_ _} _ _. +Arguments FA {_ _} _ {_ _} _, {_ _} _ _ _ _. + +Section Opposite_Functor. + Context {C D : Category} (F : Functor C D). + + Program Definition Opposite_Functor : (Functor (Opposite C) (Opposite D)) := + {| + FO := FO F; + FA := fun _ _ h => FA F h; + |}. + +End Opposite_Functor. + +Section Functor_Compose. + Context {C C' C'' : Category} (F : Functor C C') (F' : Functor C' C''). + + Program Definition Functor_compose : Functor C C'' := + {| + FO := fun c => FO F' (FO F c); + FA := fun c d f => FA F' (FA F f) + |}. + +End Functor_Compose. + +Section Algebras. + Context {C : Category} (T : Functor C C). + Record Algebra : Type := + { + Alg_Carrier : C; + Constructors : Hom (FO T Alg_Carrier) Alg_Carrier + }. + + Record Algebra_Hom (alg alg' : Algebra) : Type := + { + Alg_map : Hom (Alg_Carrier alg) (Alg_Carrier alg'); + + Alg_map_com : compose (FA T Alg_map) (Constructors alg') + = compose (Constructors alg) Alg_map + }. + + Arguments Alg_map {_ _} _. + Arguments Alg_map_com {_ _} _. + Program Definition Algebra_Hom_compose + {alg alg' alg'' : Algebra} + (h : Algebra_Hom alg alg') + (h' : Algebra_Hom alg' alg'') + : Algebra_Hom alg alg'' + := + {| + Alg_map := compose (Alg_map h) (Alg_map h') + |}. + + Next Obligation. Proof. Admitted. + + Lemma Algebra_Hom_eq_simplify (alg alg' : Algebra) + (ah ah' : Algebra_Hom alg alg') + : (Alg_map ah) = (Alg_map ah') -> ah = ah'. + Proof. Admitted. + + Program Definition Algebra_Hom_id (alg : Algebra) : Algebra_Hom alg alg := + {| + Alg_map := id + |}. + + Next Obligation. Admitted. + + Definition Algebra_Cat : Category := + {| + Obj := Algebra; + Hom := Algebra_Hom; + compose := @Algebra_Hom_compose; + id := Algebra_Hom_id; + |}. + +End Algebras. + +Arguments Alg_Carrier {_ _} _. +Arguments Constructors {_ _} _. +Arguments Algebra_Hom {_ _} _ _. +Arguments Alg_map {_ _ _ _} _. +Arguments Alg_map_com {_ _ _ _} _. +Arguments Algebra_Hom_id {_ _} _. + +Section CoAlgebras. + Context {C : Category}. + + Definition CoAlgebra (T : Functor C C) := + @Algebra (Opposite C) (Opposite_Functor T). + + Definition CoAlgebra_Hom {T : Functor C C} := + @Algebra_Hom (Opposite C) (Opposite_Functor T). + + Definition CoAlgebra_Hom_id {T : Functor C C} := + @Algebra_Hom_id (Opposite C) (Opposite_Functor T). + + Definition CoAlgebra_Cat (T : Functor C C) := + @Algebra_Cat (Opposite C) (Opposite_Functor T). + +End CoAlgebras. + +Program Definition Type_Cat : Category := +{| + Obj := Type; + Hom := (fun A B => A -> B); + compose := fun A B C (g : A -> B) (h : B -> C) => fun (x : A) => h (g x); + id := fun A => fun x => x +|}. + +Local Obligation Tactic := idtac. + +Program Definition Prod_Cat (C C' : Category) : Category := +{| + Obj := C * C'; + Hom := + fun a b => + ((Hom (fst a) (fst b)) * (Hom (snd a) (snd b)))%type; + compose := + fun a b c f g => + ((compose (fst f) (fst g)), (compose (snd f)(snd g))); + id := fun c => (id, id) +|}. + +Class Terminal (C : Category) : Type := +{ + terminal : C; + t_morph : forall (d : Obj), Hom d terminal; + t_morph_unique : forall (d : Obj) (f g : (Hom d terminal)), f = g +}. + +Arguments terminal {_} _. +Arguments t_morph {_} _ _. +Arguments t_morph_unique {_} _ _ _ _. + +Coercion terminal : Terminal >-> Obj. + +Definition Initial (C : Category) := Terminal (Opposite C). +Existing Class Initial. + +Record Product {C : Category} (c d : C) : Type := +{ + product : C; + Pi_1 : Hom product c; + Pi_2 : Hom product d; + Prod_morph_ex : forall (p' : Obj) (r1 : Hom p' c) (r2 : Hom p' d), (Hom p' product); +}. + +Arguments Product _ _ _, {_} _ _. + +Arguments Pi_1 {_ _ _ _}, {_ _ _} _. +Arguments Pi_2 {_ _ _ _}, {_ _ _} _. +Arguments Prod_morph_ex {_ _ _} _ _ _ _. + +Coercion product : Product >-> Obj. + +Definition Has_Products (C : Category) : Type := forall a b, Product a b. + +Existing Class Has_Products. + +Program Definition Prod_Func (C : Category) {HP : Has_Products C} + : Functor (Prod_Cat C C) C := +{| + FO := fun x => HP (fst x) (snd x); + FA := fun a b f => Prod_morph_ex _ _ (compose Pi_1 (fst f)) (compose Pi_2 (snd f)) +|}. + +Arguments Prod_Func _ _, _ {_}. + +Definition Sum (C : Category) := @Product (Opposite C). + +Arguments Sum _ _ _, {_} _ _. + +Definition Has_Sums (C : Category) : Type := forall (a b : C), (Sum a b). + +Existing Class Has_Sums. + +Program Definition sum_Sum (A B : Type) : (@Sum Type_Cat A B) := +{| + product := (A + B)%type; + Prod_morph_ex := + fun (p' : Type) + (r1 : A -> p') + (r2 : B -> p') + (X : A + B) => + match X return p' with + | inl a => r1 a + | inr b => r2 b + end +|}. +Next Obligation. simpl; auto. Defined. +Next Obligation. simpl; auto. Defined. + +Program Instance Type_Cat_Has_Sums : Has_Sums Type_Cat := sum_Sum. + +Definition Sum_Func {C : Category} {HS : Has_Sums C} : + Functor (Prod_Cat C C) C := Opposite_Functor (Prod_Func (Opposite C) HS). + +Arguments Sum_Func _ _, _ {_}. + +Program Instance unit_Type_term : Terminal Type_Cat := +{ + terminal := unit; + t_morph := fun _ _=> tt +}. + +Next Obligation. Proof. Admitted. + +Program Definition term_id : Functor Type_Cat (Prod_Cat Type_Cat Type_Cat) := +{| + FO := fun a => (@terminal Type_Cat _, a); + FA := fun a b f => (@id _ (@terminal Type_Cat _), f) +|}. + +Definition S_nat_func : Functor Type_Cat Type_Cat := + Functor_compose term_id (Sum_Func Type_Cat _). + +Definition S_nat_alg_cat := Algebra_Cat S_nat_func. + +CoInductive CoNat : Set := + | CoO : CoNat + | CoS : CoNat -> CoNat +. + +Definition S_nat_coalg_cat := @CoAlgebra_Cat Type_Cat S_nat_func. + +Set Printing Universes. +Program Definition CoNat_alg_term : Initial S_nat_coalg_cat := +{| + terminal := _; + t_morph := _ +|}. + +Next Obligation. Admitted. +Next Obligation. Admitted. + +Axiom Admit : False. + +Next Obligation. +Proof. + intros d f g. + assert(H1 := (@Alg_map_com _ _ _ _ f)). clear. + assert (inl tt = inr tt) by (exfalso; apply Admit). + discriminate. + all: exfalso; apply Admit. + Show Universes. +Qed. diff --git a/test-suite/bugs/closed/bug_5215_2.v b/test-suite/bugs/closed/bug_5215_2.v new file mode 100644 index 0000000000..399947f00f --- /dev/null +++ b/test-suite/bugs/closed/bug_5215_2.v @@ -0,0 +1,8 @@ +Require Import Coq.Program.Tactics. +Set Universe Polymorphism. +Set Printing Universes. +Definition typ := Type. + +Program Definition foo : typ := _ -> _. +Next Obligation. Admitted. +Next Obligation. exact typ. Show Proof. Show Universes. Defined. diff --git a/test-suite/bugs/closed/bug_5219.v b/test-suite/bugs/closed/bug_5219.v new file mode 100644 index 0000000000..f7cec1a0cf --- /dev/null +++ b/test-suite/bugs/closed/bug_5219.v @@ -0,0 +1,10 @@ +(* Test surgical use of beta-iota in the type of variables coming from + pattern-matching for refine *) + +Goal forall x : sigT (fun x => x = 1), True. + intro x; refine match x with + | existT _ x' e' => _ + end. + lazymatch goal with + | [ H : _ = _ |- _ ] => idtac + end. diff --git a/test-suite/bugs/closed/bug_5233.v b/test-suite/bugs/closed/bug_5233.v new file mode 100644 index 0000000000..06286c740d --- /dev/null +++ b/test-suite/bugs/closed/bug_5233.v @@ -0,0 +1,2 @@ +(* Implicit arguments on type were missing for recursive records *) +Inductive foo {A : Type} : Type := { Foo : foo }. diff --git a/test-suite/bugs/closed/bug_5245.v b/test-suite/bugs/closed/bug_5245.v new file mode 100644 index 0000000000..e5bca5b5e4 --- /dev/null +++ b/test-suite/bugs/closed/bug_5245.v @@ -0,0 +1,18 @@ +Set Primitive Projections. + +Record foo := Foo { + foo_car : Type; + foo_rel : foo_car -> foo_car -> Prop +}. +Arguments foo_rel : simpl never. + +Definition foo_fun {A B} := Foo (A -> B) (fun f g => forall x, f x = g x). + +Goal @foo_rel foo_fun (fun x : nat => x) (fun x => x). +Proof. +intros x; exact eq_refl. +Undo. +progress hnf; intros; exact eq_refl. +Undo. +unfold foo_rel. intros x. exact eq_refl. +Qed. diff --git a/test-suite/bugs/closed/bug_5255.v b/test-suite/bugs/closed/bug_5255.v new file mode 100644 index 0000000000..5daaf9edbf --- /dev/null +++ b/test-suite/bugs/closed/bug_5255.v @@ -0,0 +1,24 @@ +Section foo. + Context (x := 1). + Definition foo : x = 1 := eq_refl. +End foo. + +Module Type Foo. + Context (x := 1). + Definition foo : x = 1 := eq_refl. +End Foo. + +Set Universe Polymorphism. + +Inductive unit := tt. +Inductive eq {A} (x y : A) : Type := eq_refl : eq x y. + +Section bar. + Context (x := tt). + Definition bar : eq x tt := eq_refl _ _. +End bar. + +Module Type Bar. + Context (x := tt). + Definition bar : eq x tt := eq_refl _ _. +End Bar. diff --git a/test-suite/bugs/closed/bug_5277.v b/test-suite/bugs/closed/bug_5277.v new file mode 100644 index 0000000000..449bb9b0a7 --- /dev/null +++ b/test-suite/bugs/closed/bug_5277.v @@ -0,0 +1,11 @@ +(* Scheme Equality not robust wrt names *) + +Module A1. + Inductive A (T : Type) := C (a : T). + Scheme Equality for A. (* success *) +End A1. + +Module A2. + Inductive A (x : Type) := C (a : x). + Scheme Equality for A. +End A2. diff --git a/test-suite/bugs/closed/bug_5281.v b/test-suite/bugs/closed/bug_5281.v new file mode 100644 index 0000000000..03bafdc9ae --- /dev/null +++ b/test-suite/bugs/closed/bug_5281.v @@ -0,0 +1,6 @@ +Inductive A (T : Prop) := B (_ : T). +Scheme Equality for A. + +Goal forall (T:Prop), (forall x y : T, {x=y}+{x<>y}) -> forall x y : A T, {x=y}+{x<>y}. +decide equality. +Qed. diff --git a/test-suite/bugs/closed/bug_5286.v b/test-suite/bugs/closed/bug_5286.v new file mode 100644 index 0000000000..98d4e5c968 --- /dev/null +++ b/test-suite/bugs/closed/bug_5286.v @@ -0,0 +1,9 @@ +Set Primitive Projections. + +CoInductive R := mkR { p : unit }. + +CoFixpoint foo := mkR tt. + +Check (eq_refl tt : p foo = tt). +Check (eq_refl tt <: p foo = tt). +Check (eq_refl tt <<: p foo = tt). diff --git a/test-suite/bugs/closed/bug_5300.v b/test-suite/bugs/closed/bug_5300.v new file mode 100644 index 0000000000..18202df508 --- /dev/null +++ b/test-suite/bugs/closed/bug_5300.v @@ -0,0 +1,39 @@ +Module Test1. + + Module Type Foo. + Parameter t : unit. + End Foo. + + Module Bar : Foo. + Module Type Rnd. Definition t' : unit := tt. End Rnd. + Module Rnd_inst : Rnd. Definition t' : unit := tt. End Rnd_inst. + Definition t : unit. + exact Rnd_inst.t'. + Qed. + End Bar. + + Print Assumptions Bar.t. +End Test1. + +Module Test2. + Module Type Foo. + Parameter t1 : unit. + Parameter t2 : unit. + End Foo. + + Module Bar : Foo. + Inductive ind := . + Definition t' : unit := tt. + Definition t1 : unit. + Proof. + exact ((fun (_ : ind -> False) => tt) (fun H => match H with end)). + Qed. + Definition t2 : unit. + Proof. + exact t'. + Qed. + End Bar. + + Print Assumptions Bar.t1. + Print Assumptions Bar.t1. +End Test2. diff --git a/test-suite/bugs/closed/bug_5315.v b/test-suite/bugs/closed/bug_5315.v new file mode 100644 index 0000000000..7ecd511651 --- /dev/null +++ b/test-suite/bugs/closed/bug_5315.v @@ -0,0 +1,10 @@ +Require Import Recdef. + +Function dumb_works (a:nat) {struct a} := + match (fun x => x) a with O => O | S n' => dumb_works n' end. + +Function dumb_nope (a:nat) {struct a} := + match (id (fun x => x)) a with O => O | S n' => dumb_nope n' end. + +(* This check is just present to ensure Function worked well *) +Check R_dumb_nope_complete. diff --git a/test-suite/bugs/closed/bug_5321.v b/test-suite/bugs/closed/bug_5321.v new file mode 100644 index 0000000000..3c32a4cb4d --- /dev/null +++ b/test-suite/bugs/closed/bug_5321.v @@ -0,0 +1,18 @@ +Definition proj1_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v) + : proj1_sig u = proj1_sig v + := f_equal (@proj1_sig _ _) p. + +Definition proj2_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v) + : eq_rect _ _ (proj2_sig u) _ (proj1_sig_path p) = proj2_sig v + := match p with eq_refl => eq_refl end. + +Goal forall sz : nat, + let sz' := sz in + forall pf : sz = sz', + let feq_refl := exist (fun x : nat => sz = x) sz' eq_refl in + let fpf := exist (fun x : nat => sz = x) sz' pf in feq_refl = fpf -> +proj2_sig feq_refl = proj2_sig fpf. +Proof. + intros. + etransitivity; [ | exact (proj2_sig_path H) ]. + Fail clearbody fpf. diff --git a/test-suite/bugs/closed/bug_5322.v b/test-suite/bugs/closed/bug_5322.v new file mode 100644 index 0000000000..01aec8f29b --- /dev/null +++ b/test-suite/bugs/closed/bug_5322.v @@ -0,0 +1,14 @@ +(* Regression in computing types of branches in "match" *) +Inductive flat_type := Unit | Prod (A B : flat_type). +Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type +-> Type := +| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR. +Inductive op : flat_type -> flat_type -> Type := a : op Unit Unit. +Arguments Op {_ _ _ _} _ _. +Definition bound_op {var} + {src2 dst2} + (opc2 : op src2 dst2) + : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2. + refine match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with + | _ => _ + end. diff --git a/test-suite/bugs/closed/bug_5323.v b/test-suite/bugs/closed/bug_5323.v new file mode 100644 index 0000000000..dec423338c --- /dev/null +++ b/test-suite/bugs/closed/bug_5323.v @@ -0,0 +1,26 @@ +(* Revealed a missing re-consideration of postponed problems *) + +Module A. +Inductive flat_type := Unit | Prod (A B : flat_type). +Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type +-> Type := +| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR. +Inductive op : flat_type -> flat_type -> Type := . +Arguments Op {_ _ _ _} _ _. +Definition bound_op {var} + {src2 dst2} + (opc2 : op src2 dst2) + : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2 + := match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with end. +End A. + +(* A shorter variant *) +Module B. +Inductive exprf (op : unit -> Type) : Type := +| A : exprf op +| Op tR (opc : op tR) (args : exprf op) : exprf op. +Inductive op : unit -> Type := . +Definition bound_op (dst2 : unit) (opc2 : op dst2) + : forall (args2 : exprf op), Op op dst2 opc2 args2 = A op + := match opc2 in op h return (forall args2 : exprf ?[U], Op ?[V] ?[I] opc2 args2 = A op) with end. +End B. diff --git a/test-suite/bugs/closed/bug_5331.v b/test-suite/bugs/closed/bug_5331.v new file mode 100644 index 0000000000..901389e02e --- /dev/null +++ b/test-suite/bugs/closed/bug_5331.v @@ -0,0 +1,10 @@ +(* Checking no anomaly on some unexpected intropattern *) + +Ltac ih H := induction H as H. +Ltac ih' H H' := induction H as H'. + +Goal True -> True. +Fail intro H; ih H. +intro H; ih' H ipattern:([]). +exact I. +Qed. diff --git a/test-suite/bugs/closed/bug_5345.v b/test-suite/bugs/closed/bug_5345.v new file mode 100644 index 0000000000..d8448f35db --- /dev/null +++ b/test-suite/bugs/closed/bug_5345.v @@ -0,0 +1,7 @@ +Ltac break_tuple := + match goal with + | [ H: context[match ?a with | pair n m => _ end] |- _ ] => + let n := fresh n in + let m := fresh m in + destruct a as [n m] + end. diff --git a/test-suite/bugs/closed/bug_5346.v b/test-suite/bugs/closed/bug_5346.v new file mode 100644 index 0000000000..0118c18704 --- /dev/null +++ b/test-suite/bugs/closed/bug_5346.v @@ -0,0 +1,29 @@ +Inductive comp : Type -> Type := +| Ret {T} : forall (v:T), comp T +| Bind {T T'} : forall (p: comp T') (p': T' -> comp T), comp T. + +Notation "'do' x .. y <- p1 ; p2" := + (Bind p1 (fun x => .. (fun y => p2) ..)) + (at level 60, right associativity, + x binder, y binder). + +Definition Fst1 A B (p: comp (A*B)) : comp A := + do '(a, b) <- p; + Ret a. + +Definition Fst2 A B (p: comp (A*B)) : comp A := + match tt with + | _ => Bind p (fun '(a, b) => Ret a) + end. + +Definition Fst3 A B (p: comp (A*B)) : comp A := + match tt with + | _ => do a <- p; + Ret (fst a) + end. + +Definition Fst A B (p: comp (A * B)) : comp A := + match tt with + | _ => do '(a, b) <- p; + Ret a + end. diff --git a/test-suite/bugs/closed/bug_5347.v b/test-suite/bugs/closed/bug_5347.v new file mode 100644 index 0000000000..9267b3eb69 --- /dev/null +++ b/test-suite/bugs/closed/bug_5347.v @@ -0,0 +1,10 @@ +Set Universe Polymorphism. + +Axiom X : Type. +(* Used to declare [x0@{u1 u2} : X@{u1}] and [x1@{} : X@{u2}] leaving + the type of x1 with undeclared universes. After PR #891 this should + error at declaration time. *) +Axiom x₀ x₁ : X. +Axiom Xᵢ : X -> Type. + +Check Xᵢ x₁. (* conversion test raised anomaly universe undefined *) diff --git a/test-suite/bugs/closed/bug_5359.v b/test-suite/bugs/closed/bug_5359.v new file mode 100644 index 0000000000..a5a96db2c3 --- /dev/null +++ b/test-suite/bugs/closed/bug_5359.v @@ -0,0 +1,218 @@ +Require Import Coq.nsatz.Nsatz. +Goal False. + + (* the first (succeeding) goal was reached by clearing one hypothesis in the second goal which overflows 6GB of stack space *) + let sugar := constr:( 0%Z ) in + let nparams := constr:( (-1)%Z ) in + let reified_goal := constr:( + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) ) in + let power := constr:( N.one ) in + let reified_givens := constr:( + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) + :: Ring_polynom.PEsub + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) + :: Ring_polynom.PEsub + (Ring_polynom.PEmul + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEX Z 9)) (Ring_polynom.PEc 1%Z) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) + (Ring_polynom.PEX Z 7))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) (Ring_polynom.PEX Z 8))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) + (Ring_polynom.PEX Z 7))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) + (Ring_polynom.PEX Z 8)))) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) + (Ring_polynom.PEX Z 5))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) + (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) + (Ring_polynom.PEX Z 5))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) + (Ring_polynom.PEX Z 6)))) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 2))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 3))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 2))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 3)))) :: nil)%list ) in + Nsatz.nsatz_compute + (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). + + let sugar := constr:( 0%Z ) in + let nparams := constr:( (-1)%Z ) in + let reified_goal := constr:( + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) ) in + let power := constr:( N.one ) in + let reified_givens := constr:( + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) + :: Ring_polynom.PEadd + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6)))) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 6)) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 5)))) (Ring_polynom.PEX Z 7)) + (Ring_polynom.PEsub + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) (Ring_polynom.PEX Z 6)) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)))) + (Ring_polynom.PEX Z 8)) + :: Ring_polynom.PEsub + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) + :: Ring_polynom.PEsub + (Ring_polynom.PEmul + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) (Ring_polynom.PEX Z 9)) + (Ring_polynom.PEc 1%Z) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) + (Ring_polynom.PEX Z 7))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) + (Ring_polynom.PEX Z 8))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) + (Ring_polynom.PEX Z 7))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) + (Ring_polynom.PEX Z 8)))) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) + (Ring_polynom.PEX Z 5))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) + (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) + (Ring_polynom.PEX Z 5))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) + (Ring_polynom.PEX Z 6)))) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 2))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 3))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 2))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 3)))) :: nil)%list ) in + Nsatz.nsatz_compute + (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). diff --git a/test-suite/bugs/closed/bug_5365.v b/test-suite/bugs/closed/bug_5365.v new file mode 100644 index 0000000000..be360d24d2 --- /dev/null +++ b/test-suite/bugs/closed/bug_5365.v @@ -0,0 +1,13 @@ + +Inductive TupleT : nat -> Type := +| nilT : TupleT 0 +| consT {n} A : (A -> TupleT n) -> TupleT (S n). + +Inductive Tuple : forall n, TupleT n -> Type := + nil : Tuple _ nilT +| cons {n A} (x : A) (F : A -> TupleT n) : Tuple _ (F x) -> Tuple _ (consT A F). + +Inductive TupleMap : forall n, TupleT n -> TupleT n -> Type := + tmNil : TupleMap _ nilT nilT +| tmCons {n} {A B : Type} (F : A -> TupleT n) (G : B -> TupleT n) + : (forall x, sigT (fun y => TupleMap _ (F x) (G y))) -> TupleMap _ (consT A F) (consT B G). diff --git a/test-suite/bugs/closed/bug_5368.v b/test-suite/bugs/closed/bug_5368.v new file mode 100644 index 0000000000..410fe1707d --- /dev/null +++ b/test-suite/bugs/closed/bug_5368.v @@ -0,0 +1,6 @@ +Set Universe Polymorphism. + +Record cantype := {T:Type; op:T -> unit}. +Canonical Structure test (P:Type) := {| T := P -> Type; op := fun _ => tt|}. + +Check (op _ ((fun (_:unit) => Set):_)). diff --git a/test-suite/bugs/closed/bug_5372.v b/test-suite/bugs/closed/bug_5372.v new file mode 100644 index 0000000000..e60244cd1d --- /dev/null +++ b/test-suite/bugs/closed/bug_5372.v @@ -0,0 +1,8 @@ +(* coq bug 5372: https://coq.inria.fr/bugs/show_bug.cgi?id=5372 *) +Require Import FunInd. +Function odd (n:nat) := + match n with + | 0 => false + | S n => true + end +with even (n:nat) := false. diff --git a/test-suite/bugs/closed/bug_5377.v b/test-suite/bugs/closed/bug_5377.v new file mode 100644 index 0000000000..130d9f9abf --- /dev/null +++ b/test-suite/bugs/closed/bug_5377.v @@ -0,0 +1,54 @@ +Goal ((forall (t : Type) (x y : t), + True -> + x = y)) -> False. +Proof. + intro HG. + let P := lazymatch goal with + | [ H : forall t x y, True -> @?P t x y + |- _ ] + => P + end in + pose (f := P). + unify f (fun (t : Type) (x y : t) => x = y). +Abort. + +Goal True. +Proof. +let c := lazymatch constr:(fun (T : nat -> Type) (y : nat) (_ : T y) => y) with + | fun _ y _ => @?C y => C + end in +pose (f := c). +unify f (fun n : nat => n). +Abort. + +Goal (forall x : nat, x = x -> x = x \/ x = x) -> True. +Proof. +intro. +let P := lazymatch goal with +| [ H : forall y, @?P y -> @?P y \/ _ |- _ ] + => P +end in +pose (f := P). +unify f (fun x : nat => x = x). +Abort. + +Goal (forall x : nat, x = x -> x = x \/ x = x) -> True. +Proof. +intro. +lazymatch goal with +| [ H : forall y, @?P y -> @?Q y \/ _ |- _ ] + => idtac +end. +Abort. + +Axiom eq : forall {T} (_ : T), Prop. + +Goal forall _ : (forall t (_ : eq t) (x : t), eq x), Prop. +Proof. +intro. +let P := lazymatch goal with +| [ H : forall t _ x, @?P t x |- _ ] + => P +end in +pose (f := P). +Abort. diff --git a/test-suite/bugs/closed/bug_5401.v b/test-suite/bugs/closed/bug_5401.v new file mode 100644 index 0000000000..95193b993b --- /dev/null +++ b/test-suite/bugs/closed/bug_5401.v @@ -0,0 +1,21 @@ +(* Testing printing of bound unnamed variables in pattern printer *) + +Module A. +Parameter P : nat -> Type. +Parameter v : forall m, P m. +Parameter f : forall (P : nat -> Type), (forall a, P a) -> P 0. +Class U (R : P 0) (m : forall x, P x) : Prop. +Instance w : U (f _ (fun _ => v _)) v. +Print HintDb typeclass_instances. +End A. + +(* #5731 *) + +Module B. +Axiom rel : Type -> Prop. +Axiom arrow_rel : forall {A1}, A1 -> rel A1. +Axiom forall_rel : forall E, (forall v1 : Type, E v1 -> rel v1) -> Prop. +Axiom inl_rel: forall_rel _ (fun _ => arrow_rel). +Hint Resolve inl_rel : foo. +Print HintDb foo. +End B. diff --git a/test-suite/bugs/closed/bug_5414.v b/test-suite/bugs/closed/bug_5414.v new file mode 100644 index 0000000000..2522a274fb --- /dev/null +++ b/test-suite/bugs/closed/bug_5414.v @@ -0,0 +1,12 @@ +(* Use of idents bound to ltac names in a "match" *) + +Definition foo : Type. +Proof. + let x := fresh "a" in + refine (forall k : nat * nat, let '(x, _) := k in (_ : Type)). + exact (a = a). +Defined. +Goal foo. +intros k. elim k. (* elim because elim keeps names *) +intros. +Check a. (* We check that the name is "a" *) diff --git a/test-suite/bugs/closed/bug_5434.v b/test-suite/bugs/closed/bug_5434.v new file mode 100644 index 0000000000..5d2460face --- /dev/null +++ b/test-suite/bugs/closed/bug_5434.v @@ -0,0 +1,18 @@ +(* About binders which remain unnamed after typing *) + +Global Set Asymmetric Patterns. + +Definition proj2_sig_map {A} {P Q : A -> Prop} (f : forall a, P a -> Q a) (x : +@sig A P) : @sig A Q + := let 'exist a p := x in exist Q a (f a p). +Axioms (feBW' : Type) (g : Prop -> Prop) (f' : feBW' -> Prop). +Definition foo := @proj2_sig_map feBW' (fun H => True = f' _) (fun H => + g True = g (f' H)) + (fun (a : feBW') (p : (fun H : feBW' => True = + f' H) a) => @f_equal Prop Prop g True (f' a) p). +Print foo. +Goal True. + lazymatch type of foo with + | sig (fun a : ?A => ?P) -> _ + => pose (fun a : A => a = a /\ P = P) + end. diff --git a/test-suite/bugs/closed/bug_5435.v b/test-suite/bugs/closed/bug_5435.v new file mode 100644 index 0000000000..62e3b2a1a1 --- /dev/null +++ b/test-suite/bugs/closed/bug_5435.v @@ -0,0 +1 @@ +Definition foo (x : nat) := Eval native_compute in x. diff --git a/test-suite/bugs/closed/bug_5449.v b/test-suite/bugs/closed/bug_5449.v new file mode 100644 index 0000000000..d7fc2aaa00 --- /dev/null +++ b/test-suite/bugs/closed/bug_5449.v @@ -0,0 +1,6 @@ +(* An example of decide equality which was failing due to a lhs dep into the rhs *) + +Require Import Coq.PArith.BinPos. +Goal forall x y, {Pos.compare_cont Gt x y = Gt} + {Pos.compare_cont Gt x y <> Gt}. +intros. +decide equality. diff --git a/test-suite/bugs/closed/bug_5460.v b/test-suite/bugs/closed/bug_5460.v new file mode 100644 index 0000000000..50221cdd83 --- /dev/null +++ b/test-suite/bugs/closed/bug_5460.v @@ -0,0 +1,11 @@ +(* Bugs in computing dependencies in pattern-matching compilation *) + +Inductive A := a1 | a2. +Inductive B := b. +Inductive C : A -> Type := c : C a1 | d : C a2. +Definition P (x : A) (y : C x) (z : B) : nat := + match z, x, y with + | b, a1, c => 0 + | b, a2, d => 0 + | _, _, _ => 1 + end. diff --git a/test-suite/bugs/closed/bug_5470.v b/test-suite/bugs/closed/bug_5470.v new file mode 100644 index 0000000000..5b3984b6df --- /dev/null +++ b/test-suite/bugs/closed/bug_5470.v @@ -0,0 +1,3 @@ +(* This used to raise an anomaly *) + +Fail Reserved Notation "x +++ y" (at level 70, x binder). diff --git a/test-suite/bugs/closed/bug_5476.v b/test-suite/bugs/closed/bug_5476.v new file mode 100644 index 0000000000..7c0c2c1dfd --- /dev/null +++ b/test-suite/bugs/closed/bug_5476.v @@ -0,0 +1,28 @@ +Require Setoid. + +Goal forall (P : Prop) (T : Type) (m m' : T) (T0 T1 : Type) (P2 : forall _ : +Prop, Prop) + (P0 : Set) (x0 : P0) (P1 : forall (_ : P0) (_ : T), Prop) + (P3 : forall (_ : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (_ : +T) (_ : Prop), Prop) + (o : forall _ : P0, option T1) + (_ : P3 + (fun (k : P0) (_ : T0) (_ : Prop) => + match o k return Prop with + | Some _ => True + | None => False + end) m' P) (_ : P2 (P1 x0 m)) + (_ : forall (f : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (m1 m2 +: T) + (k : P0) (e : T0) (_ : P2 (P1 k m1)), iff (P3 f m2 P) +(f k e (P3 f m1 P))), False. +Proof. + intros ???????????? H0 H H1. + rewrite H1 in H0; eauto with nocore. + { lazymatch goal with + | H : match ?X with _ => _ end |- _ + => first [ lazymatch goal with + | [ H' : context[X] |- _ ] => idtac H + end + | fail 1 "could not find" X ] + end. diff --git a/test-suite/bugs/closed/bug_5486.v b/test-suite/bugs/closed/bug_5486.v new file mode 100644 index 0000000000..b1ddfe24bf --- /dev/null +++ b/test-suite/bugs/closed/bug_5486.v @@ -0,0 +1,15 @@ +Axiom proof_admitted : False. +Tactic Notation "admit" := abstract case proof_admitted. +Goal forall (T : Type) (p : prod (prod T T) bool) (Fm : Set) (f : Fm) (k : + forall _ : T, Fm), + @eq Fm + (k + match p return T with + | pair p0 swap => fst p0 + end) f. + intros. + (* next statement failed in Bug 5486 *) + match goal with + | [ |- ?f (let (a, b) := ?d in @?e a b) = ?rhs ] + => pose (let (a, b) := d in e a b) as t0 + end. diff --git a/test-suite/bugs/closed/bug_5487.v b/test-suite/bugs/closed/bug_5487.v new file mode 100644 index 0000000000..9b995f4503 --- /dev/null +++ b/test-suite/bugs/closed/bug_5487.v @@ -0,0 +1,9 @@ +(* Was a collision between an ltac pattern variable and an evar *) + +Goal forall n, exists m, n = m :> nat. +Proof. + eexists. + Fail match goal with + | [ |- ?x = ?y ] + => match x with y => idtac end + end. diff --git a/test-suite/bugs/closed/bug_5500.v b/test-suite/bugs/closed/bug_5500.v new file mode 100644 index 0000000000..aa63e2ab0e --- /dev/null +++ b/test-suite/bugs/closed/bug_5500.v @@ -0,0 +1,35 @@ +(* Too weak check on the correctness of return clause was leading to an anomaly *) + +Inductive Vector A: nat -> Type := + nil: Vector A O +| cons: forall n, A -> Vector A n -> Vector A (S n). + +(* This could be made working with a better inference of inner return + predicates from the return predicate at the higher level of the + nested matching. Currently, we only check that it does not raise an + anomaly, but eventually, the "Fail" could be removed. *) + +Fail Definition hd_fst A x n (v: A * Vector A (S n)) := + match v as v0 return match v0 with + (l, r) => + match r in Vector _ n return match n with 0 => Type | S _ => Type end with + nil _ => A + | cons _ _ _ _ => A + end + end with + (_, nil _) => x + | (_, cons _ n hd tl) => hd + end. + +(* This is another example of failure but involving beta-reduction and + not iota-reduction. Thus, for this one, I don't see how it could be + solved by small inversion, whatever smart is small inversion. *) + +Inductive A : (Type->Type) -> Type := J : A (fun x => x). + +Fail Check fun x : nat * A (fun x => x) => + match x return match x with + (y,z) => match z in A f return f Type with J => bool end + end with + (y,J) => true + end. diff --git a/test-suite/bugs/closed/bug_5501.v b/test-suite/bugs/closed/bug_5501.v new file mode 100644 index 0000000000..24739a3658 --- /dev/null +++ b/test-suite/bugs/closed/bug_5501.v @@ -0,0 +1,21 @@ +Set Universe Polymorphism. + +Record Pred@{A} := + { car :> Type@{A} + ; P : car -> Prop + }. + +Class All@{A} (A : Pred@{A}) : Type := + { proof : forall (a : A), P A a + }. + +Record Pred_All@{A} : Type := + { P' :> Pred@{A} + ; P'_All : All P' + }. + +Global Instance Pred_All_instance (A : Pred_All) : All A := P'_All A. + +Definition Pred_All_proof {A : Pred_All} (a : A) : P A a. +Proof. +solve[auto using proof]. diff --git a/test-suite/bugs/closed/bug_5522.v b/test-suite/bugs/closed/bug_5522.v new file mode 100644 index 0000000000..0fae9ede42 --- /dev/null +++ b/test-suite/bugs/closed/bug_5522.v @@ -0,0 +1,7 @@ +(* Checking support for scope delimiters and as clauses in 'pat + applied to notations with binders *) + +Notation "'multifun' x .. y 'in' f" := (fun x => .. (fun y => f) .. ) + (at level 200, x binder, y binder, f at level 200). + +Check multifun '((x, y)%core as z) in (x+y,0)=z. diff --git a/test-suite/bugs/closed/bug_5523.v b/test-suite/bugs/closed/bug_5523.v new file mode 100644 index 0000000000..d7582a3797 --- /dev/null +++ b/test-suite/bugs/closed/bug_5523.v @@ -0,0 +1,6 @@ +(* Support for complex constructions in recursive notations, especially "match". *) + +Definition Let_In {A P} (x : A) (f : forall a : A, P a) : P x := let y := x in f y. +Notation "'dlet' x , y := v 'in' ( a , b , .. , c )" + := (Let_In v (fun '(x, y) => pair .. (pair a b) .. c)) + (at level 0). diff --git a/test-suite/bugs/closed/bug_5526.v b/test-suite/bugs/closed/bug_5526.v new file mode 100644 index 0000000000..88f219be30 --- /dev/null +++ b/test-suite/bugs/closed/bug_5526.v @@ -0,0 +1,3 @@ +Fail Notation "x === x" := (eq_refl x) (at level 10). +Reserved Notation "x === x" (only printing, at level 10). +Notation "x === x" := (eq_refl x) (only printing). diff --git a/test-suite/bugs/closed/bug_5532.v b/test-suite/bugs/closed/bug_5532.v new file mode 100644 index 0000000000..ee5446e548 --- /dev/null +++ b/test-suite/bugs/closed/bug_5532.v @@ -0,0 +1,15 @@ +(* A wish granted by the new support for patterns in notations *) + +Local Notation mkmatch0 e p + := match e with + | p => true + | _ => false + end. +Local Notation "'mkmatch' [[ e ]] [[ p ]]" + := match e with + | p => true + | _ => false + end + (at level 0, p pattern). +Check mkmatch0 _ ((0, 0)%core). +Check mkmatch [[ _ ]] [[ ((0, 0)%core) ]]. diff --git a/test-suite/bugs/closed/bug_5539.v b/test-suite/bugs/closed/bug_5539.v new file mode 100644 index 0000000000..48e5568e9b --- /dev/null +++ b/test-suite/bugs/closed/bug_5539.v @@ -0,0 +1,15 @@ +Set Universe Polymorphism. + +Inductive D : nat -> Type := +| DO : D O +| DS n : D n -> D (S n). + +Fixpoint follow (n : nat) : D n -> Prop := + match n with + | O => fun d => let 'DO := d in True + | S n' => fun d => (let 'DS _ d' := d in fun f => f d') (follow n') + end. + +Definition step (n : nat) (d : D n) (H : follow n d) : + follow (S n) (DS n d) + := H. diff --git a/test-suite/bugs/closed/bug_5547.v b/test-suite/bugs/closed/bug_5547.v new file mode 100644 index 0000000000..79633f4893 --- /dev/null +++ b/test-suite/bugs/closed/bug_5547.v @@ -0,0 +1,16 @@ +(* Checking typability of intermediate return predicates in nested pattern-matching *) + +Inductive A : (Type->Type) -> Type := J : A (fun x => x). +Definition ret (x : nat * A (fun x => x)) + := match x return Type with + | (y,z) => match z in A f return f Type with + | J => bool + end + end. +Definition foo : forall x, ret x. +Proof. +Fail refine (fun x + => match x return ret x with + | (y,J) => true + end + ). diff --git a/test-suite/bugs/closed/bug_5550.v b/test-suite/bugs/closed/bug_5550.v new file mode 100644 index 0000000000..bb1222489a --- /dev/null +++ b/test-suite/bugs/closed/bug_5550.v @@ -0,0 +1,10 @@ +Section foo. + + Variable bar : Prop. + Variable H : bar. + + Goal bar. + typeclasses eauto with foobar. + Qed. + +End foo. diff --git a/test-suite/bugs/closed/bug_5578.v b/test-suite/bugs/closed/bug_5578.v new file mode 100644 index 0000000000..19d36e635d --- /dev/null +++ b/test-suite/bugs/closed/bug_5578.v @@ -0,0 +1,57 @@ +(* File reduced by coq-bug-finder from original input, then from 1549 lines to 298 lines, then from 277 lines to 133 lines, then from 985 lines to 138 lines, then from 206 lines to 139 lines, then from 203 lines to 142 lines, then from 262 lines to 152 lines, then from 567 lines to 151 lines, then from 3746 lines to 151 lines, then from 577 lines to 151 lines, then from 187 lines to 151 lines, thenfrom 981 lines to 940 lines, then from 938 lines to 175 lines, then from 589 lines to 205 lines, then from 3797 lines to 205 lines, then from 628 lines to 206 lines, then from 238 lines to 205 lines, then from 1346 lines to 213 lines, then from 633 lines to 214 lines, then from 243 lines to 213 lines, then from 5656 lines to 245 lines, then from 661 lines to 272 lines, then from 3856 lines to 352 lines, then from 1266 lines to 407 lines, then from 421 lines to 406 lines, then from 424 lines to 91 lines, then from 105 lines to 91 lines, then from 85 lines to 55 lines, then from 69 lines to 55 lines *) +(* coqc version trunk (May 2017) compiled on May 30 2017 13:28:59 with OCaml +4.02.3 + coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-trunk,trunk (fd36c0451c26e44b1b7e93299d3367ad2d35fee3) *) + +Class Proper {A} (R : A -> A -> Prop) (m : A) := mkp : R m m. +Definition respectful {A B} (R : A -> A -> Prop) (R' : B -> B -> Prop) (f g : A -> B) := forall x y, R x y -> R' (f x) (g y). +Set Implicit Arguments. + +Class EqDec (A : Set) := { + eqb : A -> A -> bool ; + eqb_leibniz : forall x y, eqb x y = true <-> x = y +}. + +Infix "?=" := eqb (at level 70) : eq_scope. + +Inductive Comp : Set -> Type := +| Bind : forall (A B : Set), Comp B -> (B -> Comp A) -> Comp A. + +Open Scope eq_scope. + +Goal forall (Rat : Set) (PositiveMap_t : Set -> Set) + type (t : type) (interp_type_list_message interp_type_rand interp_type_message : nat -> Set), + (forall eta : nat, PositiveMap_t (interp_type_rand eta) -> interp_type_list_message eta -> interp_type_message eta) -> + ((nat -> Rat) -> Prop) -> + forall (interp_type_sbool : nat -> Set) (interp_type0 : type -> nat -> Set), + (forall eta : nat, + (interp_type_list_message eta -> interp_type_message eta) -> PositiveMap_t (interp_type_rand eta) -> interp_type0 t eta) + -> (forall (t0 : type) (eta : nat), EqDec (interp_type0 t0 eta)) + -> (bool -> Comp bool) -> False. + clear. + intros Rat PositiveMap_t type t interp_type_list_message interp_type_rand interp_type_message adv negligible interp_type_sbool + interp_type interp_term_fixed_t_x + EqDec_interp_type ret_bool. + assert (forall f adv' k + (lem : forall (eta : nat) (evil_rands rands : PositiveMap_t +(interp_type_rand eta)), + (interp_term_fixed_t_x eta (adv eta evil_rands) rands + ?= interp_term_fixed_t_x eta (adv eta evil_rands) rands) = true), + (forall (eta : nat), Proper (respectful eq eq) (f eta)) + -> negligible + (fun eta : nat => + f eta ( + (Bind (k eta) (fun rands => + ret_bool (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands)))))). + Undo. + assert (forall f adv' k + (lem : forall (eta : nat) (rands : PositiveMap_t +(interp_type_rand eta)), + (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands) = true), + (forall (eta : nat), Proper (respectful eq eq) (f eta)) + -> negligible + (fun eta : nat => + f eta ( + (Bind (k eta) (fun rands => + ret_bool (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands)))))). + (* Error: Anomaly "Signature and its instance do not match." Please report at http://coq.inria.fr/bugs/. *) diff --git a/test-suite/bugs/closed/bug_5598.v b/test-suite/bugs/closed/bug_5598.v new file mode 100644 index 0000000000..55fef1a575 --- /dev/null +++ b/test-suite/bugs/closed/bug_5598.v @@ -0,0 +1,8 @@ +(* Checking when discharge of an existing class is possible *) +Section foo. + Context {T} (a : T) (b : T). + Let k := eq_refl a. + Existing Class eq. + Fail Global Existing Instance k. + Existing Instance k. +End foo. diff --git a/test-suite/bugs/closed/bug_5608.v b/test-suite/bugs/closed/bug_5608.v new file mode 100644 index 0000000000..7e1c2f2491 --- /dev/null +++ b/test-suite/bugs/closed/bug_5608.v @@ -0,0 +1,33 @@ +Reserved Notation "'slet' x .. y := A 'in' b" + (at level 200, x binder, y binder, b at level 200, format "'slet' x .. y := A 'in' '//' b"). +Reserved Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" + (at level 200, format "T x [1] = { A } ; '//' 'return' ( b0 , b1 , .. , b2 )"). + +Delimit Scope ctype_scope with ctype. +Local Open Scope ctype_scope. +Delimit Scope expr_scope with expr. +Inductive base_type := TZ | TWord (logsz : nat). +Inductive flat_type := Tbase (T : base_type) | Prod (A B : flat_type). +Context {var : base_type -> Type}. +Fixpoint interp_flat_type (interp_base_type : base_type -> Type) (t : +flat_type) := + match t with + | Tbase t => interp_base_type t + | Prod x y => prod (interp_flat_type interp_base_type x) (interp_flat_type +interp_base_type y) + end. +Inductive exprf : flat_type -> Type := +| Var {t} (v : var t) : exprf (Tbase t) +| LetIn {tx} (ex : exprf tx) {tC} (eC : interp_flat_type var tx -> exprf tC) : +exprf tC +| Pair {tx} (ex : exprf tx) {ty} (ey : exprf ty) : exprf (Prod tx ty). +Global Arguments Var {_} _. +Global Arguments LetIn {_} _ {_} _. +Global Arguments Pair {_} _ {_} _. +Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" := (LetIn (tx:=T) A +(fun x => Pair .. (Pair b0%expr b1%expr) .. b2%expr)) : expr_scope. +Definition foo := + (fun x3 => + (LetIn (Var x3) (fun x18 : var TZ + => (Pair (Var x18) (Var x18))))). +Print foo. diff --git a/test-suite/bugs/closed/bug_5618.v b/test-suite/bugs/closed/bug_5618.v new file mode 100644 index 0000000000..47e0e92d2a --- /dev/null +++ b/test-suite/bugs/closed/bug_5618.v @@ -0,0 +1,9 @@ +Require Import FunInd. + +Function test {T} (v : T) (x : nat) : nat := + match x with + | 0 => 0 + | S x' => test v x' + end. + +Check R_test_complete. diff --git a/test-suite/bugs/closed/bug_5641.v b/test-suite/bugs/closed/bug_5641.v new file mode 100644 index 0000000000..9f3246f33d --- /dev/null +++ b/test-suite/bugs/closed/bug_5641.v @@ -0,0 +1,6 @@ +Set Universe Polymorphism. + +Definition foo@{i j} (A : Type@{i}) : Type@{j}. +Proof. +abstract (exact ltac:(abstract (exact A))). +Defined. diff --git a/test-suite/bugs/closed/bug_5666.v b/test-suite/bugs/closed/bug_5666.v new file mode 100644 index 0000000000..d55a6e57b4 --- /dev/null +++ b/test-suite/bugs/closed/bug_5666.v @@ -0,0 +1,4 @@ +Inductive foo := Foo : False -> foo. +Goal foo. +try (constructor ; fail 0). +Fail try (constructor ; fail 1). diff --git a/test-suite/bugs/closed/bug_5671.v b/test-suite/bugs/closed/bug_5671.v new file mode 100644 index 0000000000..c9a085045a --- /dev/null +++ b/test-suite/bugs/closed/bug_5671.v @@ -0,0 +1,7 @@ +(* Fixing Meta-unclean specialize *) + +Require Import Setoid. +Axiom a : forall x, x=0 -> True. +Lemma lem (x y1 y2:nat) (H:x=0) (H0:eq y1 y2) : y1 = y2. +specialize a with (1:=H). clear H x. intros _. +setoid_rewrite H0. diff --git a/test-suite/bugs/closed/bug_5683.v b/test-suite/bugs/closed/bug_5683.v new file mode 100644 index 0000000000..b5c6a48ec0 --- /dev/null +++ b/test-suite/bugs/closed/bug_5683.v @@ -0,0 +1,71 @@ +Require Import Program.Tactics. +Require Import FunctionalExtensionality. + +Inductive Succ A := +| Succ_O : Succ A +| Succ_S : A -> Succ A. +Arguments Succ_O {A}. +Arguments Succ_S {A} _. + +Inductive Zero : Type :=. + +Inductive ty := +| ty_nat : ty +| ty_arr : ty -> ty -> ty. + +Inductive term A := +| term_abs : ty -> term (Succ A) -> term A +| term_app : term A -> term A -> term A +| term_var : A -> term A +| term_nat : nat -> term A. +Arguments term_abs {A} _ _. +Arguments term_app {A} _ _. +Arguments term_var {A} _. +Arguments term_nat {A} _. + +Class Functor F := +{ + ret : forall {A}, A -> F A; + fmap : forall {A B}, (A -> B) -> F A -> F B; + fmap_id : forall {A} (fa : F A), fmap (@id A) fa = fa; + fmap_compose : forall {A B C} (fa : F A) (g : B -> C) (h : A -> B), fmap (fun +a => g (h a)) fa = fmap g (fmap h fa) +}. + +Class Monad M `{Functor M} := +{ + bind : forall {A B}, M A -> (A -> M B) -> M B; + ret_left_id : forall {A B} (a : A) (f : A -> M B), bind (ret a) f = f a; + ret_right_id : forall {A} (m : M A), bind m ret = m; + bind_assoc : forall {A B C} (m : M A) (f : A -> M B) (g : B -> M C), bind +(bind m f) g = bind m (fun x => bind (f x) g) +}. + +Instance Succ_Functor : Functor Succ. +Proof. + unshelve econstructor. + - intros A B f fa. + destruct fa. + + apply Succ_O. + + apply Succ_S. tauto. + - intros. apply Succ_S. assumption. + - intros A [|a]; reflexivity. + - intros A B C [|a] g h; reflexivity. +Defined. + +(* Anomaly: Not an arity *) +Program Fixpoint term_bind {A B} (tm : term A) (f : A -> term B) : term B := + let Succ_f (var : Succ A) := + match var with + | Succ_O => term_var Succ_O + | Succ_S var' => _ + end in + match tm with + | term_app tm1 tm2 => term_app (term_bind tm1 f) (term_bind tm2 f) + | term_abs ty body => term_abs ty (term_bind body Succ_f) + | term_var a => f a + | term_nat n => term_nat n + end. +Next Obligation. + intros. +Admitted. diff --git a/test-suite/bugs/closed/bug_5692.v b/test-suite/bugs/closed/bug_5692.v new file mode 100644 index 0000000000..4c8d464f19 --- /dev/null +++ b/test-suite/bugs/closed/bug_5692.v @@ -0,0 +1,88 @@ +Set Primitive Projections. +Require Import ZArith ssreflect. + +Module Test1. + +Structure semigroup := SemiGroup { + sg_car :> Type; + sg_op : sg_car -> sg_car -> sg_car; +}. + +Structure monoid := Monoid { + monoid_car :> Type; + monoid_op : monoid_car -> monoid_car -> monoid_car; + monoid_unit : monoid_car; +}. + +Coercion monoid_sg (X : monoid) : semigroup := + SemiGroup (monoid_car X) (monoid_op X). +Canonical Structure monoid_sg. + +Parameter X : monoid. +Parameter x y : X. + +Check (sg_op _ x y). + +End Test1. + +Module Test2. + +Structure semigroup := SemiGroup { + sg_car :> Type; + sg_op : sg_car -> sg_car -> sg_car; +}. + +Structure monoid := Monoid { + monoid_car :> Type; + monoid_op : monoid_car -> monoid_car -> monoid_car; + monoid_unit : monoid_car; + monoid_left_id x : monoid_op monoid_unit x = x; +}. + +Coercion monoid_sg (X : monoid) : semigroup := + SemiGroup (monoid_car X) (monoid_op X). +Canonical Structure monoid_sg. + +Canonical Structure nat_sg := SemiGroup nat plus. +Canonical Structure nat_monoid := Monoid nat plus 0 plus_O_n. + +Lemma foo (x : nat) : 0 + x = x. +Proof. +apply monoid_left_id. +Qed. + +End Test2. + +Module Test3. + +Structure semigroup := SemiGroup { + sg_car :> Type; + sg_op : sg_car -> sg_car -> sg_car; +}. + +Structure group := Something { + group_car :> Type; + group_op : group_car -> group_car -> group_car; + group_neg : group_car -> group_car; + group_neg_op' x y : group_neg (group_op x y) = group_op (group_neg x) (group_neg y) +}. + +Coercion group_sg (X : group) : semigroup := + SemiGroup (group_car X) (group_op X). +Canonical Structure group_sg. + +Axiom group_neg_op : forall (X : group) (x y : X), + group_neg X (sg_op (group_sg X) x y) = sg_op (group_sg X) (group_neg X x) (group_neg X y). + +Canonical Structure Z_sg := SemiGroup Z Z.add . +Canonical Structure Z_group := Something Z Z.add Z.opp Z.opp_add_distr. + +Lemma foo (x y : Z) : + sg_op Z_sg (group_neg Z_group x) (group_neg Z_group y) = + group_neg Z_group (sg_op Z_sg x y). +Proof. + rewrite -group_neg_op. + reflexivity. +Qed. + +End Test3. diff --git a/test-suite/bugs/closed/bug_5696.v b/test-suite/bugs/closed/bug_5696.v new file mode 100644 index 0000000000..a20ad1b4da --- /dev/null +++ b/test-suite/bugs/closed/bug_5696.v @@ -0,0 +1,5 @@ +(* Slightly improving interpretation of Ltac subterms in notations *) + +Notation "'var2' x .. y = z ; e" := (ltac:(exact z), (fun x => .. (fun y => e) +..)) (at level 200, x binder, y binder, e at level 220). +Check (var2 a = 1; a). diff --git a/test-suite/bugs/closed/bug_5697.v b/test-suite/bugs/closed/bug_5697.v new file mode 100644 index 0000000000..c653f992af --- /dev/null +++ b/test-suite/bugs/closed/bug_5697.v @@ -0,0 +1,19 @@ +Set Primitive Projections. + +Record foo : Type := Foo { foo_car: nat }. + +Goal forall x y : nat, x <> y -> Foo x <> Foo y. +Proof. +intros. +intros H'. +congruence. +Qed. + +Record bar (A : Type) : Type := Bar { bar_car: A }. + +Goal forall x y : nat, x <> y -> Bar nat x <> Bar nat y. +Proof. +intros. +intros H'. +congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_5707.v b/test-suite/bugs/closed/bug_5707.v new file mode 100644 index 0000000000..785844c66d --- /dev/null +++ b/test-suite/bugs/closed/bug_5707.v @@ -0,0 +1,12 @@ +(* Destruct and primitive projections *) + +(* Checking the (superficial) part of #5707: + "destruct" should be able to use non-dependent case analysis when + dependent case analysis is not available and unneeded *) + +Set Primitive Projections. + +Inductive foo := Foo { proj1 : nat; proj2 : nat }. + +Goal forall x : foo, True. +Proof. intros x. destruct x. diff --git a/test-suite/bugs/closed/bug_5713.v b/test-suite/bugs/closed/bug_5713.v new file mode 100644 index 0000000000..9daf9647fc --- /dev/null +++ b/test-suite/bugs/closed/bug_5713.v @@ -0,0 +1,15 @@ +(* Checking that classical_right/classical_left work in an empty context *) + +Require Import Classical. + +Parameter A:Prop. + +Goal A \/ ~A. +classical_right. +assumption. +Qed. + +Goal ~A \/ A. +classical_left. +assumption. +Qed. diff --git a/test-suite/bugs/closed/bug_5717.v b/test-suite/bugs/closed/bug_5717.v new file mode 100644 index 0000000000..1bfd917d25 --- /dev/null +++ b/test-suite/bugs/closed/bug_5717.v @@ -0,0 +1,5 @@ +Definition foo@{i} (A : Type@{i}) (l : list A) := + match l with + | nil => nil + | cons _ t => t + end. diff --git a/test-suite/bugs/closed/bug_5719.v b/test-suite/bugs/closed/bug_5719.v new file mode 100644 index 0000000000..0fad5f54ea --- /dev/null +++ b/test-suite/bugs/closed/bug_5719.v @@ -0,0 +1,9 @@ +Axiom cons_data_one : + forall (Aone : unit -> Set) (i : unit) (a : Aone i), nat. +Axiom P : nat -> Prop. +Axiom children_data_rect3 : forall {Aone : unit -> Set} + (cons_one_case : forall (i : unit) (b : Aone i), + nat -> nat -> P (cons_data_one Aone i b)), + P 0. +Fail Definition decide_children_equality IH := children_data_rect3 + (fun _ '(existT _ _ _) => match IH with tt => _ end). diff --git a/test-suite/bugs/closed/bug_5726.v b/test-suite/bugs/closed/bug_5726.v new file mode 100644 index 0000000000..53ef473572 --- /dev/null +++ b/test-suite/bugs/closed/bug_5726.v @@ -0,0 +1,34 @@ +Set Universe Polymorphism. +Set Printing Universes. + +Module GlobalReference. + + Definition type' := Type. + Notation type := type'. + Check type@{Set}. + +End GlobalReference. + +Module TypeLiteral. + + Notation type := Type. + Check type@{Set}. + Check type@{Prop}. + +End TypeLiteral. + +Module ExplicitSort. + Monomorphic Universe u. + Notation foo := Type@{u}. + Fail Check foo@{Set}. + Fail Check foo@{u}. + + Notation bar := Type. + Check bar@{u}. +End ExplicitSort. + +Module PropNotationUnsupported. + Notation foo := Prop. + Fail Check foo@{Set}. + Fail Check foo@{Type}. +End PropNotationUnsupported. diff --git a/test-suite/bugs/closed/bug_5741.v b/test-suite/bugs/closed/bug_5741.v new file mode 100644 index 0000000000..f6598f192d --- /dev/null +++ b/test-suite/bugs/closed/bug_5741.v @@ -0,0 +1,4 @@ +(* Check no anomaly in info_trivial *) + +Goal True. +info_trivial. diff --git a/test-suite/bugs/closed/bug_5749.v b/test-suite/bugs/closed/bug_5749.v new file mode 100644 index 0000000000..81bfe351c5 --- /dev/null +++ b/test-suite/bugs/closed/bug_5749.v @@ -0,0 +1,18 @@ +(* Checking computation of free vars of a term for generalization *) + +Definition Decision := fun P : Prop => {P} + {~ P}. +Class SetUnfold (P Q : Prop) : Prop := Build_SetUnfold { set_unfold : P <-> Q +}. + +Section Filter_Help. + + Context {A: Type}. + Context (fold_right : forall A B : Type, (B -> A -> A) -> A -> list B -> A). + Definition lType2 := (sigT (fun (P : A -> Prop) => forall a, Decision (P +a))). + Definition test (X: lType2) := let (x, _) := X in x. + + Global Instance foo `{fhl1 : list lType2} m Q: + SetUnfold (Q) + (fold_right _ _ (fun (s : lType2) => let (P, _) := s in and (P +m)) (Q) (fhl1)). diff --git a/test-suite/bugs/closed/bug_5750.v b/test-suite/bugs/closed/bug_5750.v new file mode 100644 index 0000000000..6d0e21f5d0 --- /dev/null +++ b/test-suite/bugs/closed/bug_5750.v @@ -0,0 +1,3 @@ +(* Check printability of the hole of the context *) +Goal 0 = 0. +match goal with |- context c [0] => idtac c end. diff --git a/test-suite/bugs/closed/bug_5755.v b/test-suite/bugs/closed/bug_5755.v new file mode 100644 index 0000000000..e07fdcf831 --- /dev/null +++ b/test-suite/bugs/closed/bug_5755.v @@ -0,0 +1,16 @@ +(* Sections taking care of let-ins for inductive types *) + +Section Foo. + +Inductive foo (A : Type) (x : A) (y := x) (y : A) := Foo. + +End Foo. + +Section Foo2. + +Variable B : Type. +Variable b : B. +Let c := b. +Inductive foo2 (A : Type) (x : A) (y := x) (y : A) := Foo2 : c=c -> foo2 A x y. + +End Foo2. diff --git a/test-suite/bugs/closed/bug_5757.v b/test-suite/bugs/closed/bug_5757.v new file mode 100644 index 0000000000..0d0f2eed44 --- /dev/null +++ b/test-suite/bugs/closed/bug_5757.v @@ -0,0 +1,76 @@ +(* Check that resolved status of evars follows "restrict" *) + +Axiom H : forall (v : nat), Some 0 = Some v -> True. +Lemma L : True. +eapply H with _; +match goal with + | |- Some 0 = Some ?v => change (Some (0+0) = Some v) +end. +Abort. + +(* The original example *) + +Set Default Proof Using "Type". + +Module heap_lang. + +Inductive expr := + | InjR (e : expr). + +Inductive val := + | InjRV (v : val). + +Bind Scope val_scope with val. + +Fixpoint of_val (v : val) : expr := + match v with + | InjRV v => InjR (of_val v) + end. + +Fixpoint to_val (e : expr) : option val := None. + +End heap_lang. +Export heap_lang. + +Module W. +Inductive expr := + | Val (v : val) + (* Sums *) + | InjR (e : expr). + +Fixpoint to_expr (e : expr) : heap_lang.expr := + match e with + | Val v => of_val v + | InjR e => heap_lang.InjR (to_expr e) + end. + +End W. + + + +Section Tests. + + Context (iProp: Type). + Context (WPre: expr -> Prop). + + Context (tac_wp_alloc : + forall (e : expr) (v : val), + to_val e = Some v -> WPre e). + + Lemma push_atomic_spec (x: val) : + WPre (InjR (of_val x)). + Proof. +(* This works. *) +eapply tac_wp_alloc with _. +match goal with + | |- to_val ?e = Some ?v => + change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v) +end. +Undo. Undo. +(* This is fixed *) +eapply tac_wp_alloc with _; +match goal with + | |- to_val ?e = Some ?v => + change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v) +end. +Abort. diff --git a/test-suite/bugs/closed/bug_5761.v b/test-suite/bugs/closed/bug_5761.v new file mode 100644 index 0000000000..6f28d1981a --- /dev/null +++ b/test-suite/bugs/closed/bug_5761.v @@ -0,0 +1,126 @@ +Set Primitive Projections. +Record mix := { a : nat ; b : a = a ; c : nat ; d : a = c ; e : nat ; f : nat }. +Ltac strip_args T ctor := + lazymatch type of ctor with + | context[T] + => match eval cbv beta in ctor with + | ?ctor _ => strip_args T ctor + | _ => ctor + end + end. +Ltac get_ctor T := + let full_ctor := constr:(ltac:(let x := fresh in intro x; econstructor; apply +x) : T -> T) in + let ctor := constr:(fun x : T => ltac:(let v := strip_args T (full_ctor x) in +exact v)) in + lazymatch ctor with + | fun _ => ?ctor => ctor + end. +Ltac uncurry_domain f := + lazymatch type of f with + | forall (a : ?A) (b : @ ?B a), _ + => uncurry_domain (fun ab : { a : A & B a } => f (projT1 ab) (projT2 ab)) + | _ => eval cbv beta in f + end. +Ltac get_of_sigma T := + let ctor := get_ctor T in + uncurry_domain ctor. +Ltac repeat_existT := + lazymatch goal with + | [ |- sigT _ ] => simple refine (existT _ _ _); [ repeat_existT | shelve ] + | _ => shelve + end. + Ltac prove_to_of_sigma_goal of_sigma := + let v := fresh "v" in + simple refine (exist _ _ (fun v => _ : id _ (of_sigma v) = v)); + try unfold of_sigma; + [ intro v; destruct v; repeat_existT + | cbv beta; + repeat match goal with + | [ |- context[projT2 ?k] ] + => let x := fresh "x" in + is_var k; + destruct k as [k x]; cbn [projT1 projT2] + end; + unfold id; reflexivity ]. +Ltac prove_to_of_sigma of_sigma := + constr:( + ltac:(prove_to_of_sigma_goal of_sigma) + : { to_sigma : _ | forall v, id to_sigma (of_sigma v) = v }). +Ltac get_to_sigma_gen of_sigma := + let v := prove_to_of_sigma of_sigma in + eval hnf in (proj1_sig v). +Ltac get_to_sigma T := + let of_sigma := get_of_sigma T in + get_to_sigma_gen of_sigma. +Definition to_sigma := ltac:(let v := get_to_sigma mix in exact v). +(* Error: +In nested Ltac calls to "get_to_sigma", "get_to_sigma_gen", +"prove_to_of_sigma", +"(_ : {to_sigma : _ | forall v, id to_sigma (of_sigma v) = v})" (with +of_sigma:=fun + ab : {_ + : {_ + : {ab : {_ : {a : nat & a = a} & nat} & + projT1 (projT1 ab) = projT2 ab} & nat} & nat} => + {| + a := projT1 (projT1 (projT1 (projT1 (projT1 ab)))); + b := projT2 (projT1 (projT1 (projT1 (projT1 ab)))); + c := projT2 (projT1 (projT1 (projT1 ab))); + d := projT2 (projT1 (projT1 ab)); + e := projT2 (projT1 ab); + f := projT2 ab |}) and "prove_to_of_sigma_goal", last call failed. +Anomaly "Uncaught exception Not_found." Please report at +http://coq.inria.fr/bugs/. +frame @ file "toplevel/coqtop.ml", line 640, characters 6-22 +frame @ file "list.ml", line 73, characters 12-15 +frame @ file "toplevel/vernac.ml", line 344, characters 2-13 +frame @ file "toplevel/vernac.ml", line 308, characters 14-75 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "lib/flags.ml", line 141, characters 19-40 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "lib/flags.ml", line 11, characters 15-18 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "toplevel/vernac.ml", line 167, characters 6-16 +frame @ file "toplevel/vernac.ml", line 151, characters 26-39 +frame @ file "stm/stm.ml", line 2365, characters 2-35 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "stm/stm.ml", line 2355, characters 4-48 +frame @ file "stm/stm.ml", line 2321, characters 4-100 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "stm/stm.ml", line 832, characters 6-10 +frame @ file "stm/stm.ml", line 2206, characters 10-32 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "stm/stm.ml", line 975, characters 8-81 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "vernac/vernacentries.ml", line 2216, characters 10-389 +frame @ file "lib/flags.ml", line 141, characters 19-40 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "lib/flags.ml", line 11, characters 15-18 +frame @ file "vernac/command.ml", line 150, characters 4-56 +frame @ file "interp/constrintern.ml", line 2046, characters 2-73 +frame @ file "pretyping/pretyping.ml", line 1194, characters 19-77 +frame @ file "pretyping/pretyping.ml", line 1155, characters 8-72 +frame @ file "pretyping/pretyping.ml", line 628, characters 23-65 +frame @ file "plugins/ltac/tacinterp.ml", line 2095, characters 21-61 +frame @ file "proofs/pfedit.ml", line 178, characters 6-22 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "proofs/pfedit.ml", line 174, characters 8-36 +frame @ file "proofs/proof.ml", line 351, characters 4-30 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "engine/proofview.ml", line 1222, characters 8-12 +frame @ file "plugins/ltac/tacinterp.ml", line 2020, characters 19-36 +frame @ file "plugins/ltac/tacinterp.ml", line 618, characters 4-70 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "plugins/ltac/tacinterp.ml", line 214, characters 6-9 +frame @ file "pretyping/pretyping.ml", line 1198, characters 19-62 +frame @ file "pretyping/pretyping.ml", line 1155, characters 8-72 +raise @ unknown +frame @ file "pretyping/pretyping.ml", line 628, characters 23-65 +frame @ file "plugins/ltac/tacinterp.ml", line 2095, characters 21-61 +frame @ file "proofs/pfedit.ml", line 178, characters 6-22 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 +frame @ file "proofs/pfedit.ml", line 174, characters 8-36 +frame @ file "proofs/proof.ml", line 351, characters 4-30 +raise @ file "lib/exninfo.ml", line 63, characters 8-15 + *) diff --git a/test-suite/bugs/closed/bug_5762.v b/test-suite/bugs/closed/bug_5762.v new file mode 100644 index 0000000000..55d36bd722 --- /dev/null +++ b/test-suite/bugs/closed/bug_5762.v @@ -0,0 +1,34 @@ +(* Supporting imp. params. in inductive or fixpoints mutually defined with a notation *) + +Reserved Notation "* a" (at level 70). +Inductive P {n : nat} : nat -> Prop := +| c m : *m +where "* m" := (P m). + +Reserved Notation "##". +Inductive I {A:Type} := C : ## where "##" := I. + +(* The following was working in 8.6 *) + +Require Import Vector. + +Reserved Notation "# a" (at level 70). +Fixpoint f {n : nat} (v:Vector.t nat n) : nat := + match v with + | nil _ => 0 + | cons _ _ _ v => S (#v) + end +where "# v" := (f v). + +(* The following was working in 8.6 *) + +Reserved Notation "%% a" (at level 70). +Record R := + {g : forall {A} (a:A), a=a where "%% x" := (g x); + k : %% 0 = eq_refl}. + +(* An extra example *) + +Module A. +Inductive I {A:Type} := C : # 0 -> I where "# I" := (I = I) : I_scope. +End A. diff --git a/test-suite/bugs/closed/bug_5765.v b/test-suite/bugs/closed/bug_5765.v new file mode 100644 index 0000000000..343ab49357 --- /dev/null +++ b/test-suite/bugs/closed/bug_5765.v @@ -0,0 +1,3 @@ +(* 'pat binder not (yet?) allowed in parameters of inductive types *) + +Fail Inductive X '(a,b) := x. diff --git a/test-suite/bugs/closed/bug_5769.v b/test-suite/bugs/closed/bug_5769.v new file mode 100644 index 0000000000..42573aad87 --- /dev/null +++ b/test-suite/bugs/closed/bug_5769.v @@ -0,0 +1,20 @@ +(* Check a few naming heuristics based on types *) +(* was buggy for types names _something *) + +Inductive _foo :=. +Lemma bob : (sigT (fun x : nat => _foo)) -> _foo. +destruct 1. +exact _f. +Abort. + +Inductive _'Foo :=. +Lemma bob : (sigT (fun x : nat => _'Foo)) -> _'Foo. +destruct 1. +exact _'f. +Abort. + +Inductive ____ :=. +Lemma bob : (sigT (fun x : nat => ____)) -> ____. +destruct 1. +exact x0. +Abort. diff --git a/test-suite/bugs/closed/bug_5786.v b/test-suite/bugs/closed/bug_5786.v new file mode 100644 index 0000000000..f25fcd3eb2 --- /dev/null +++ b/test-suite/bugs/closed/bug_5786.v @@ -0,0 +1,26 @@ +(* Printing all kinds of Ltac generic arguments *) + +Tactic Notation "myidtac" string(v) := idtac v. +Goal True. +myidtac "foo". +Abort. + +Tactic Notation "myidtac2" ref(c) := idtac c. +Goal True. +myidtac2 True. +Abort. + +Tactic Notation "myidtac3" preident(s) := idtac s. +Goal True. +myidtac3 foo. +Abort. + +Tactic Notation "myidtac4" int_or_var(n) := idtac n. +Goal True. +myidtac4 3. +Abort. + +Tactic Notation "myidtac5" ident(id) := idtac id. +Goal True. +myidtac5 foo. +Abort. diff --git a/test-suite/bugs/closed/bug_5790.v b/test-suite/bugs/closed/bug_5790.v new file mode 100644 index 0000000000..6c93a3906e --- /dev/null +++ b/test-suite/bugs/closed/bug_5790.v @@ -0,0 +1,7 @@ +Set Universe Polymorphism. +Section foo. +Context (v : Type). +Axiom a : True <-> False. + +Hint Resolve -> a. +End foo. diff --git a/test-suite/bugs/closed/bug_5797.v b/test-suite/bugs/closed/bug_5797.v new file mode 100644 index 0000000000..23d86a0a20 --- /dev/null +++ b/test-suite/bugs/closed/bug_5797.v @@ -0,0 +1,212 @@ +Set Implicit Arguments. + +Open Scope type_scope. + +Inductive One : Set := inOne: One. + +Definition maybe: forall A B:Set,(A -> B) -> One + A -> One + B. +Proof. + intros A B f c. + case c. + left; assumption. + right; apply f; assumption. +Defined. + +Definition id (A:Set)(a:A):=a. + +Definition LamF (X: Set -> Set)(A:Set) :Set := + A + (X A)*(X A) + X(One + A). + +Definition LamF' (X: Set -> Set)(A:Set) :Set := + LamF X A. + +Require Import List. +Require Import Bool. + +Definition index := list bool. + +Inductive L (A:Set) : index -> Set := + initL: A -> L A nil + | pluslL: forall l:index, One -> L A (false::l) + | plusrL: forall l:index, L A l -> L A (false::l) + | varL: forall l:index, L A l -> L A (true::l) + | appL: forall l:index, L A (true::l) -> L A (true::l) -> L A (true::l) + | absL: forall l:index, L A (true::false::l) -> L A (true::l). + +Scheme L_rec_simp := Minimality for L Sort Set. + +Definition Lam' (A:Set) := L A (true::nil). + +Definition aczelapp: forall (l1 l2: index)(A:Set), L (L A l2) l1 -> L A + (l1++l2). +Proof. + intros l1 l2 A. + generalize l1. + clear l1. + (* Check (fun i:index => L A (i++l2)). *) + apply (L_rec_simp (A:=L A l2) (fun i:index => L A (i++l2))). + trivial. + intros l o. + simpl app. + apply pluslL; assumption. + intros l _ t. + simpl app. + apply plusrL; assumption. + intros l _ t. + simpl app. + apply varL; assumption. + intros l _ t1 _ t2. + simpl app in *|-*. + Check 0. + apply appL; [exact t1| exact t2]. + intros l _ t. + simpl app in *|-*. + Check 0. + apply absL; assumption. +Defined. + +Definition monL: forall (l:index)(A:Set)(B:Set), (A->B) -> L A l -> L B l. +Proof. + intros l A B f. + intro t. + elim t. + intro a. + exact (initL (f a)). + intros i u. + exact (pluslL _ _ u). + intros i _ r. + exact (plusrL r). + intros i _ r. + exact (varL r). + intros i _ r1 _ r2. + exact (appL r1 r2). + intros i _ r. + exact (absL r). +Defined. + +Definition lam': forall (A B:Set), (A -> B) -> Lam' A -> Lam' B. +Proof. + intros A B f t. + unfold Lam' in *|-*. + Check 0. + exact (monL f t). +Defined. + +Definition inLam': forall A:Set, LamF' Lam' A -> Lam' A. +Proof. + intros A [[a|[t1 t2]]|r]. + unfold Lam'. + exact (varL (initL a)). + exact (appL t1 t2). + unfold Lam' in * |- *. + Check 0. + apply absL. + change (L A ((true::nil) ++ (false::nil))). + apply aczelapp. + (* Check (fun x:One + A => (match (maybe (fun a:A => initL a) x) with + | inl u => pluslL _ _ u + | inr t' => plusrL t' end)). *) + exact (monL (fun x:One + A => + (match (maybe (fun a:A => initL a) x) with + | inl u => pluslL _ _ u + | inr t' => plusrL t' end)) r). +Defined. + +Section minimal. + +Definition sub1 (F G: Set -> Set):= forall A:Set, F A->G A. +Hypothesis G: Set -> Set. +Hypothesis step: sub1 (LamF' G) G. + +Fixpoint L'(A:Set)(i:index){struct i} : Set := + match i with + nil => A + | false::l => One + L' A l + | true::l => G (L' A l) + end. + +Definition LinL': forall (A:Set)(i:index), L A i -> L' A i. +Proof. + intros A i t. + elim t. + intro a. + unfold L'. + assumption. + intros l u. + left; assumption. + intros l _ r. + right; assumption. + intros l _ r. + apply (step (A:=L' A l)). + exact (inl _ (inl _ r)). + intros l _ r1 _ r2. + apply (step (A:=L' A l)). + (* unfold L' in * |- *. + Check 0. *) + exact (inl _ (inr _ (pair r1 r2))). + intros l _ r. + apply (step (A:=L' A l)). + exact (inr _ r). +Defined. + +Definition L'inG: forall A: Set, L' A (true::nil) -> G A. +Proof. + intros A t. + unfold L' in t. + assumption. +Defined. + +Definition Itbasic: sub1 Lam' G. +Proof. + intros A t. + apply L'inG. + unfold Lam' in t. + exact (LinL' t). +Defined. + +End minimal. + +Definition recid := Itbasic inLam'. + +Definition L'Lam'inL: forall (i:index)(A:Set), L' Lam' A i -> L A i. +Proof. + intros i A t. + induction i. + unfold L' in t. + apply initL. + assumption. + induction a. + simpl L' in t. + apply (aczelapp (l1:=true::nil) (l2:=i)). + exact (lam' IHi t). + simpl L' in t. + induction t. + exact (pluslL _ _ a). + exact (plusrL (IHi b)). +Defined. + + +Lemma recidgen: forall(A:Set)(i:index)(t:L A i), L'Lam'inL i A (LinL' inLam' t) + = t. +Proof. + intros A i t. + induction t. + trivial. + trivial. + simpl. + rewrite IHt. + trivial. + simpl L'Lam'inL. + rewrite IHt. + trivial. + simpl L'Lam'inL. + simpl L'Lam'inL in IHt1. + unfold lam' in IHt1. + simpl L'Lam'inL in IHt2. + unfold lam' in IHt2. + + (* going on. This fails for the original solution. *) + rewrite IHt1. + rewrite IHt2. + trivial. +Abort. (* one goal still left *) diff --git a/test-suite/bugs/closed/bug_5845.v b/test-suite/bugs/closed/bug_5845.v new file mode 100644 index 0000000000..ea3347a851 --- /dev/null +++ b/test-suite/bugs/closed/bug_5845.v @@ -0,0 +1,7 @@ +Parameter P : forall n : nat, n=n -> Prop. + +Goal Prop. + refine (P _ _). + instantiate (1:=0). + trivial. +Qed. diff --git a/test-suite/bugs/closed/bug_5940.v b/test-suite/bugs/closed/bug_5940.v new file mode 100644 index 0000000000..32c55f667b --- /dev/null +++ b/test-suite/bugs/closed/bug_5940.v @@ -0,0 +1,11 @@ +Require Import Setoid. + +Parameter P : nat -> Prop. +Parameter Q : nat -> Prop. +Parameter PQ : forall n, P n <-> Q n. + +Lemma PQ2 : forall n, P n -> Q n. + intros. + rewrite PQ in H. + trivial. +Qed. diff --git a/test-suite/bugs/closed/bug_6070.v b/test-suite/bugs/closed/bug_6070.v new file mode 100644 index 0000000000..49b16f6254 --- /dev/null +++ b/test-suite/bugs/closed/bug_6070.v @@ -0,0 +1,32 @@ +(* A slight shortening of bug 6078 *) + +(* This bug exposed a different behavior of unshelve_unifiable + depending on which projection is found in the unification + heuristics *) + +Axiom flat_type : Type. +Axiom interp_flat_type : flat_type -> Type. +Inductive type := Arrow (_ _ : flat_type). +Definition interp_type (t : type) + := interp_flat_type (match t with Arrow s d => s end) + -> interp_flat_type (match t with Arrow s d => d end). +Axiom Expr : type -> Type. +Axiom Interp : forall {t : type}, Expr t -> interp_type t. +Axiom Wf : forall {t}, Expr t -> Prop. +Axiom a : forall f, interp_flat_type f. + +Definition packaged_expr_functionP A := + (fun F : Expr A -> Expr A + => forall e' v, Interp (F e') v = a (let (_,f) := A in f)). +Goal forall (f f0 : flat_type) + (e : forall _ : Expr (@Arrow f f0), + Expr (@Arrow f f0)), + @packaged_expr_functionP (@Arrow f f0) e. + intros. + refine (fun (e0 : Expr (Arrow f f0)) + => (fun zHwf':True => + (fun v : interp_flat_type f => + ?[G] : ?[U] = ?[V] :> interp_flat_type ?[v])) ?[H]); + [ | ]. + (* Was: Error: Tactic failure: Incorrect number of goals (expected 3 tactics). *) +Abort. diff --git a/test-suite/bugs/closed/bug_6129.v b/test-suite/bugs/closed/bug_6129.v new file mode 100644 index 0000000000..e4a2a2ba95 --- /dev/null +++ b/test-suite/bugs/closed/bug_6129.v @@ -0,0 +1,9 @@ +(* Make definition of coercions compatible with local definitions. *) + +Record foo (x : Type) (y:=1) := { foo_nat :> nat }. +Record foo2 (x : Type) (y:=1) (z t: Type) := { foo_nat2 :> nat }. +Record foo3 (y:=1) (z t: Type) := { foo_nat3 :> nat }. + +Check fun x : foo nat => x + 1. +Check fun x : foo2 nat nat nat => x + 1. +Check fun x : foo3 nat nat => x + 1. diff --git a/test-suite/bugs/closed/bug_6191.v b/test-suite/bugs/closed/bug_6191.v new file mode 100644 index 0000000000..e0d912509b --- /dev/null +++ b/test-suite/bugs/closed/bug_6191.v @@ -0,0 +1,16 @@ +(* Check a 8.7.1 regression in ring_simplify *) + +Require Import ArithRing BinNat. +Goal forall f x, (2+x+f (N.to_nat 2)+3=4). +intros. +ring_simplify (2+x+f (N.to_nat 2)+3). +match goal with |- x + f (N.to_nat 2) + 5 = 4 => idtac end. +Abort. + +Require Import ZArithRing BinInt. +Open Scope Z_scope. +Goal forall x, (2+x+3=4). +intros. +ring_simplify (2+x+3). +match goal with |- x+5 = 4 => idtac end. +Abort. diff --git a/test-suite/bugs/closed/bug_6297.v b/test-suite/bugs/closed/bug_6297.v new file mode 100644 index 0000000000..a28607058f --- /dev/null +++ b/test-suite/bugs/closed/bug_6297.v @@ -0,0 +1,8 @@ +Set Printing Universes. + +(* Error: Anomaly "Uncaught exception "Anomaly: Incorrect universe Set + declared for inductive type, inferred level is max(Prop, Set+1)."." + Please report at http://coq.inria.fr/bugs/. *) +Fail Record LTS: Set := + lts { St: Set; + init: St }. diff --git a/test-suite/bugs/closed/bug_6313.v b/test-suite/bugs/closed/bug_6313.v new file mode 100644 index 0000000000..4d263c5a82 --- /dev/null +++ b/test-suite/bugs/closed/bug_6313.v @@ -0,0 +1,64 @@ +(* Former open goals in nested proofs were lost *) + +(* This used to fail with "Incorrect number of goals (expected 1 tactic)." *) + +Inductive foo := a | b | c. +Goal foo -> foo. + intro x. + simple refine (match x with + | a => _ + | b => ltac:(exact b) + | c => _ + end); [exact a|exact c]. +Abort. + +(* This used to leave the goal on the shelf and fails at reflexivity *) + +Goal (True/\0=0 -> True) -> True. + intro f. + refine + (f ltac:(split; only 1:exact I)). + reflexivity. +Qed. + +(* The "Unshelve" used to not see the explicitly "shelved" goal *) + +Lemma f (b:comparison) : b=b. +refine (match b with + Eq => ltac:(shelve) + | Lt => ltac:(give_up) + | Gt => _ + end). +exact (eq_refl Gt). +Unshelve. +exact (eq_refl Eq). +Fail auto. (* Check that there are no more regular subgoals *) +Admitted. + +(* The "Unshelve" used to not see the explicitly "shelved" goal *) + +Lemma f2 (b:comparison) : b=b. +refine (match b with + Eq => ltac:(shelve) + | Lt => ltac:(give_up) + | Gt => _ + end). +Unshelve. (* Note: Unshelve puts goals at the end *) +exact (eq_refl Gt). +exact (eq_refl Eq). +Fail auto. (* Check that there are no more regular subgoals *) +Admitted. + +(* The "unshelve" used to not see the explicitly "shelved" goal *) + +Lemma f3 (b:comparison) : b=b. +unshelve refine (match b with + Eq => ltac:(shelve) + | Lt => ltac:(give_up) + | Gt => _ + end). +(* Note: unshelve puts goals at the beginning *) +exact (eq_refl Eq). +exact (eq_refl Gt). +Fail auto. (* Check that there are no more regular subgoals *) +Admitted. diff --git a/test-suite/bugs/closed/bug_6323.v b/test-suite/bugs/closed/bug_6323.v new file mode 100644 index 0000000000..fdc33befc6 --- /dev/null +++ b/test-suite/bugs/closed/bug_6323.v @@ -0,0 +1,9 @@ +Goal True. + simple refine (let X : Type := _ in _); + [ abstract exact Set using Set' + | let X' := (eval cbv delta [X] in X) in + clear X; + simple refine (let id' : { x : X' | True } -> X' := _ in _); + [ abstract refine (@proj1_sig _ _) | ] + ]. +Abort. diff --git a/test-suite/bugs/closed/bug_6378.v b/test-suite/bugs/closed/bug_6378.v new file mode 100644 index 0000000000..68ae7961dd --- /dev/null +++ b/test-suite/bugs/closed/bug_6378.v @@ -0,0 +1,18 @@ +Require Import Coq.ZArith.ZArith. +Ltac profile_constr tac := + let dummy := match goal with _ => reset ltac profile; start ltac profiling end in + let ret := match goal with _ => tac () end in + let dummy := match goal with _ => stop ltac profiling; show ltac profile end in + pose 1. + +Ltac slow _ := eval vm_compute in (Z.div_eucl, Z.div_eucl, Z.div_eucl, Z.div_eucl, Z.div_eucl). + +Goal True. + start ltac profiling. + reset ltac profile. + reset ltac profile. + stop ltac profiling. + time profile_constr slow. + show ltac profile cutoff 0. + show ltac profile "slow". +Abort. diff --git a/test-suite/bugs/closed/bug_6490.v b/test-suite/bugs/closed/bug_6490.v new file mode 100644 index 0000000000..dcf9ff29ed --- /dev/null +++ b/test-suite/bugs/closed/bug_6490.v @@ -0,0 +1,4 @@ +Inductive Foo (A' := I) (B : Type) := foo : Foo B. + +Goal Foo True. dtauto. Qed. +Goal Foo True. firstorder. Qed. diff --git a/test-suite/bugs/closed/bug_6529.v b/test-suite/bugs/closed/bug_6529.v new file mode 100644 index 0000000000..8d90819998 --- /dev/null +++ b/test-suite/bugs/closed/bug_6529.v @@ -0,0 +1,16 @@ +Require Import Vector Program. + +Program Definition append_nil_def := + forall A n (ls: t A n), append ls (nil A) = ls. (* Works *) + +Lemma append_nil : append_nil_def. (* Works *) +Proof. +Admitted. + +Program Lemma append_nil' : + forall A n (ls: t A n), append ls (nil A) = ls. +Abort. + +Fail Program Lemma append_nil'' : + forall A B n (ls: t A n), append ls (nil A) = ls. +(* Error: Anomaly "Evar ?X25 was not declared." Please report at http://coq.inria.fr/bugs/. *) diff --git a/test-suite/bugs/closed/bug_6534.v b/test-suite/bugs/closed/bug_6534.v new file mode 100644 index 0000000000..f5013994c5 --- /dev/null +++ b/test-suite/bugs/closed/bug_6534.v @@ -0,0 +1,7 @@ +Goal forall x : nat, x = x. +Proof. +intros x. +refine ((fun x x => _ tt) tt tt). +let t := match goal with [ |- ?P ] => P end in +let _ := type of t in +idtac. diff --git a/test-suite/bugs/closed/bug_6617.v b/test-suite/bugs/closed/bug_6617.v new file mode 100644 index 0000000000..9cabd62d48 --- /dev/null +++ b/test-suite/bugs/closed/bug_6617.v @@ -0,0 +1,34 @@ +Definition MR {T M : Type} := +fun (R : M -> M -> Prop) (m : T -> M) (x y : T) => R (m x) (m y). + +Set Primitive Projections. + +Record sigma {A : Type} {B : A -> Type} : Type := sigmaI + { pr1 : A; pr2 : B pr1 }. + +Axiom F : forall {A : Type} {R : A -> A -> Prop}, + (forall x, (forall y, R y x -> unit) -> unit) -> forall (x : A), unit. + +Definition foo (A : Type) (l : list A) := + let y := {| pr1 := A; pr2 := l |} in + let bar := MR lt (fun p : sigma => + (fix Ffix (x : list (pr1 p)) : nat := + match x with + | nil => 0 + | cons _ x1 => S (Ffix x1) + end) (pr2 p)) in +fun (_ : bar y y) => +F (fun (r : sigma) + (X : forall q : sigma, bar q r -> unit) => tt). + +Definition fooT (A : Type) (l : list A) : Type := + ltac:(let ty := type of (foo A l) in exact ty). +Parameter P : forall A l, fooT A l -> Prop. + +Goal forall A l, P A l (foo A l). +Proof. + intros; unfold foo. + Fail match goal with + | [ |- context [False]] => idtac + end. +Admitted. diff --git a/test-suite/bugs/closed/bug_6631.v b/test-suite/bugs/closed/bug_6631.v new file mode 100644 index 0000000000..100dc13fc8 --- /dev/null +++ b/test-suite/bugs/closed/bug_6631.v @@ -0,0 +1,7 @@ +Require Import Coq.derive.Derive. + +Derive f SuchThat (f = 1 + 1) As feq. +Proof. + transitivity 2; [refine (eq_refl 2)|]. + transitivity 2. + 2:abstract exact (eq_refl 2). diff --git a/test-suite/bugs/closed/bug_6634.v b/test-suite/bugs/closed/bug_6634.v new file mode 100644 index 0000000000..7f33afcc2f --- /dev/null +++ b/test-suite/bugs/closed/bug_6634.v @@ -0,0 +1,6 @@ +From Coq Require Import ssreflect. + +Lemma normalizeP (p : tt = tt) : p = p. +Proof. +Fail move: {2} tt p. +Abort. diff --git a/test-suite/bugs/closed/bug_6661.v b/test-suite/bugs/closed/bug_6661.v new file mode 100644 index 0000000000..e88a3704d8 --- /dev/null +++ b/test-suite/bugs/closed/bug_6661.v @@ -0,0 +1,259 @@ +(* -*- mode: coq; coq-prog-args: ("-noinit" "-indices-matter" "-w" "-notation-overridden,-deprecated-option") -*- *) +(* + The Coq Proof Assistant, version 8.7.1 (January 2018) + compiled on Jan 21 2018 15:02:24 with OCaml 4.06.0 + from commit 391bb5e196901a3a9426295125b8d1c700ab6992 + *) + + +Require Export Coq.Init.Notations. +Notation "'∏' x .. y , P" := (forall x, .. (forall y, P) ..) + (at level 200, x binder, y binder, right associativity) : type_scope. +Notation "'λ' x .. y , t" := (fun x => .. (fun y => t) ..) + (at level 200, x binder, y binder, right associativity). +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Reserved Notation "p @ q" (at level 60, right associativity). +Reserved Notation "! p " (at level 50). + +Monomorphic Universe uu. +Monomorphic Universe uu0. +Monomorphic Universe uu1. +Constraint uu0 < uu1. + +Global Set Universe Polymorphism. +Global Set Polymorphic Inductive Cumulativity. +Global Unset Universe Minimization ToSet. + +Notation UU := Type (only parsing). +Notation UU0 := Type@{uu0} (only parsing). + +Global Set Printing Universes. + + Inductive unit : UU0 := tt : unit. + +Inductive paths@{i} {A:Type@{i}} (a:A) : A -> Type@{i} := idpath : paths a a. +Hint Resolve idpath : core . +Notation "a = b" := (paths a b) (at level 70, no associativity) : type_scope. + +Set Primitive Projections. +Set Nonrecursive Elimination Schemes. + +Record total2@{i} { T: Type@{i} } ( P: T -> Type@{i} ) : Type@{i} + := tpair { pr1 : T; pr2 : P pr1 }. + +Arguments tpair {_} _ _ _. +Arguments pr1 {_ _} _. +Arguments pr2 {_ _} _. + +Notation "'∑' x .. y , P" := (total2 (λ x, .. (total2 (λ y, P)) ..)) + (at level 200, x binder, y binder, right associativity) : type_scope. + +Definition foo (X:Type) (xy : @total2 X (λ _, X)) : X. + induction xy as [x y]. + exact x. +Defined. + +Unset Automatic Introduction. + +Definition idfun (T : UU) := λ t:T, t. + +Definition pathscomp0 {X : UU} {a b c : X} (e1 : a = b) (e2 : b = c) : a = c. +Proof. + intros. induction e1. exact e2. +Defined. + +Hint Resolve @pathscomp0 : pathshints. + +Notation "p @ q" := (pathscomp0 p q). + +Definition pathsinv0 {X : UU} {a b : X} (e : a = b) : b = a. +Proof. + intros. induction e. exact (idpath _). +Defined. + +Notation "! p " := (pathsinv0 p). + +Definition maponpaths {T1 T2 : UU} (f : T1 -> T2) {t1 t2 : T1} + (e: t1 = t2) : f t1 = f t2. +Proof. + intros. induction e. exact (idpath _). +Defined. + +Definition map_on_two_paths {X Y Z : UU} (f : X -> Y -> Z) {x x' y y'} (ex : x = x') (ey: y = y') : + f x y = f x' y'. +Proof. + intros. induction ex. induction ey. exact (idpath _). +Defined. + + +Definition maponpathscomp0 {X Y : UU} {x1 x2 x3 : X} + (f : X -> Y) (e1 : x1 = x2) (e2 : x2 = x3) : + maponpaths f (e1 @ e2) = maponpaths f e1 @ maponpaths f e2. +Proof. + intros. induction e1. induction e2. exact (idpath _). +Defined. + +Definition maponpathsinv0 {X Y : UU} (f : X -> Y) + {x1 x2 : X} (e : x1 = x2) : maponpaths f (! e) = ! (maponpaths f e). +Proof. + intros. induction e. exact (idpath _). +Defined. + + + +Definition constr1 {X : UU} (P : X -> UU) {x x' : X} (e : x = x') : + ∑ (f : P x -> P x'), + ∑ (ee : ∏ p : P x, tpair _ x p = tpair _ x' (f p)), + ∏ (pp : P x), maponpaths pr1 (ee pp) = e. +Proof. + intros. induction e. + split with (idfun (P x)). + split with (λ p, idpath _). + unfold maponpaths. simpl. + intro. exact (idpath _). +Defined. + +Definition transportf@{i} {X : Type@{i}} (P : X -> Type@{i}) {x x' : X} + (e : x = x') : P x -> P x' := pr1 (constr1 P e). + +Lemma two_arg_paths_f@{i} {A : Type@{i}} {B : A -> Type@{i}} {C:Type@{i}} {f : ∏ a, B a -> C} {a1 b1 a2 b2} + (p : a1 = a2) (q : transportf B p b1 = b2) : f a1 b1 = f a2 b2. +Proof. + intros. induction p. induction q. exact (idpath _). +Defined. + +Definition iscontr@{i} (T:Type@{i}) : Type@{i} := ∑ cntr:T, ∏ t:T, t=cntr. + +Lemma proofirrelevancecontr {X : UU} (is : iscontr X) (x x' : X) : x = x'. +Proof. + intros. + induction is as [y fe]. + exact (fe x @ !(fe x')). +Defined. + + +Definition hfiber@{i} {X Y : Type@{i}} (f : X -> Y) (y : Y) : Type@{i} := total2 (λ x, f x = y). + +Definition hfiberpair {X Y : UU} (f : X -> Y) {y : Y} + (x : X) (e : f x = y) : hfiber f y := + tpair _ x e. + +Definition coconustot (T : UU) (t : T) := ∑ t' : T, t' = t. + +Definition coconustotpair (T : UU) {t t' : T} (e: t' = t) : coconustot T t + := tpair _ t' e. + +Lemma connectedcoconustot {T : UU} {t : T} (c1 c2 : coconustot T t) : c1 = c2. +Proof. + intros. + induction c1 as [x0 x]. + induction x. + induction c2 as [x1 y]. + induction y. + exact (idpath _). +Defined. + +Definition isweq@{i} {X Y : Type@{i}} (f : X -> Y) : Type@{i} := + ∏ y : Y, iscontr (hfiber f y). + +Lemma isProofIrrelevantUnit : ∏ x x' : unit, x = x'. +Proof. + intros. induction x. induction x'. exact (idpath _). +Defined. + +Lemma unitl0 : tt = tt -> coconustot _ tt. +Proof. + intros e. exact (coconustotpair unit e). +Defined. + +Lemma unitl1: coconustot _ tt -> tt = tt. +Proof. + intro cp. induction cp as [x t]. induction x. exact t. +Defined. + +Lemma unitl2: ∏ e : tt = tt, unitl1 (unitl0 e) = e. +Proof. + intros. unfold unitl0. simpl. exact (idpath _). +Defined. + +Lemma unitl3: ∏ e : tt = tt, e = idpath tt. +Proof. + intros. + + assert (e0 : unitl0 (idpath tt) = unitl0 e). + { simple refine (connectedcoconustot _ _). } + + set (e1 := maponpaths unitl1 e0). + + exact (! (unitl2 e) @ (! e1) @ (unitl2 (idpath _))). +Defined. + +Theorem iscontrpathsinunit (x x' : unit) : iscontr (x = x'). +Proof. + intros. + split with (isProofIrrelevantUnit x x'). + intros e'. + induction x. + induction x'. + simpl. + apply unitl3. +Qed. + +Lemma ifcontrthenunitl0 (e1 e2 : tt = tt) : e1 = e2. +Proof. + intros. + simple refine (proofirrelevancecontr _ _ _). + exact (iscontrpathsinunit tt tt). +Qed. + +Section isweqcontrtounit. + + Universe i. + + (* To see the bug, run it both with and without this constraint: *) + + (* Constraint uu0 < i. *) + + (* Without this constraint, we get i = uu0 in the next definition *) + Lemma isweqcontrtounit@{} {T : Type@{i}} (is : iscontr@{i} T) : isweq@{i} (λ _:T, tt). + Proof. + intros. intro y. induction y. + induction is as [c h]. + split with (hfiberpair@{i i i} _ c (idpath tt)). + intros ha. + induction ha as [x e]. + simple refine (two_arg_paths_f (h x) _). + simple refine (ifcontrthenunitl0 _ _). + Defined. + + (* + Explanation of the bug: + + With the constraint uu0 < i above we get: + + |= uu0 <= bug.3 + uu0 <= i + uu1 <= i + i <= bug.3 + + from this print statement: *) + + Print isweqcontrtounit. + + (* + + Without the constraint uu0 < i above we get: + + |= i <= bug.3 + uu0 = i + + Since uu0 = i is not inferred when we impose the constraint uu0 < i, + it is invalid to infer it when we don't. + + *) + + Context (X : Type@{uu1}). + + Check (@isweqcontrtounit X). (* detect a universe inconsistency *) + +End isweqcontrtounit. diff --git a/test-suite/bugs/closed/bug_6677.v b/test-suite/bugs/closed/bug_6677.v new file mode 100644 index 0000000000..99e47bb87c --- /dev/null +++ b/test-suite/bugs/closed/bug_6677.v @@ -0,0 +1,5 @@ +Set Universe Polymorphism. + +Definition T@{i} := Type@{i}. +Fail Definition U@{i} := (T@{i} <: Type@{i}). +Fail Definition eqU@{i j} : @eq T@{j} U@{i} T@{i} := eq_refl. diff --git a/test-suite/bugs/closed/bug_6770.v b/test-suite/bugs/closed/bug_6770.v new file mode 100644 index 0000000000..9bcc740830 --- /dev/null +++ b/test-suite/bugs/closed/bug_6770.v @@ -0,0 +1,7 @@ +Section visibility. + + Let Fixpoint by_proof (n:nat) : True. + Proof. exact I. Defined. +End visibility. + +Fail Check by_proof. diff --git a/test-suite/bugs/closed/bug_6774.v b/test-suite/bugs/closed/bug_6774.v new file mode 100644 index 0000000000..9625af91f5 --- /dev/null +++ b/test-suite/bugs/closed/bug_6774.v @@ -0,0 +1,7 @@ +(* Was an anomaly with ill-typed template polymorphism *) +Definition huh (b:bool) := if b then Set else Prop. +Definition lol b: huh b := + if b return huh b then nat else True. +Goal (lol true) * unit. +Fail generalize true. (* should fail with error, not anomaly *) +Abort. diff --git a/test-suite/bugs/closed/bug_6775.v b/test-suite/bugs/closed/bug_6775.v new file mode 100644 index 0000000000..206df23bce --- /dev/null +++ b/test-suite/bugs/closed/bug_6775.v @@ -0,0 +1,43 @@ +(* Issue caused and fixed during the lifetime of #6775: unification + failing on partially applied cumulative inductives. *) + +Set Universe Polymorphism. + +Set Polymorphic Inductive Cumulativity. + +Unset Elimination Schemes. + +Inductive paths@{i} {A : Type@{i}} (a : A) : A -> Type@{i} := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Arguments inverse {A x y} p : simpl nomatch. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Arguments concat {A x y z} p q : simpl nomatch. + +Notation "1" := idpath. + +Reserved Notation "p @ q" (at level 20). +Notation "p @ q" := (concat p q). + +Reserved Notation "p ^" (at level 3, format "p '^'"). +Notation "p ^" := (inverse p). + +Definition concat_pV_p {A} {x y z : A} (p : x = z) (q : y = z) : + (p @ q^) @ q = p + := + (match q as i return forall p, (p @ i^) @ i = p with + idpath => + fun p => + match p with idpath => 1 end + end) p. diff --git a/test-suite/bugs/closed/bug_6878.v b/test-suite/bugs/closed/bug_6878.v new file mode 100644 index 0000000000..70f1b3127a --- /dev/null +++ b/test-suite/bugs/closed/bug_6878.v @@ -0,0 +1,8 @@ + +Set Universe Polymorphism. +Module Type T. + Axiom foo : Prop. +End T. + +(** Used to anomaly *) +Fail Module M : T with Definition foo := Type. diff --git a/test-suite/bugs/closed/bug_6910.v b/test-suite/bugs/closed/bug_6910.v new file mode 100644 index 0000000000..5167a5364a --- /dev/null +++ b/test-suite/bugs/closed/bug_6910.v @@ -0,0 +1,5 @@ +From Coq Require Import ssreflect ssrfun. + +(* We should be able to use Some_inj as a view: *) +Lemma foo (x y : nat) : Some x = Some y -> x = y. +Proof. by move/Some_inj. Qed. diff --git a/test-suite/bugs/closed/bug_6951.v b/test-suite/bugs/closed/bug_6951.v new file mode 100644 index 0000000000..419f8d7c4e --- /dev/null +++ b/test-suite/bugs/closed/bug_6951.v @@ -0,0 +1,2 @@ +Record float2 : Set := Float2 { Fnum : unit }. +Scheme Equality for float2. diff --git a/test-suite/bugs/closed/bug_6956.v b/test-suite/bugs/closed/bug_6956.v new file mode 100644 index 0000000000..ee21adbbfd --- /dev/null +++ b/test-suite/bugs/closed/bug_6956.v @@ -0,0 +1,13 @@ +(** Used to trigger an anomaly with VM compilation *) + +Set Universe Polymorphism. + +Inductive t A : nat -> Type := +| nil : t A 0 +| cons : forall (h : A) (n : nat), t A n -> t A (S n). + +Definition case0 {A} (P : t A 0 -> Type) (H : P (nil A)) v : P v := +match v with +| nil _ => H +| _ => fun devil => False_ind (@IDProp) devil +end. diff --git a/test-suite/bugs/closed/bug_7011.v b/test-suite/bugs/closed/bug_7011.v new file mode 100644 index 0000000000..296e4e11e5 --- /dev/null +++ b/test-suite/bugs/closed/bug_7011.v @@ -0,0 +1,16 @@ +(* Fix and Cofix were missing in tactic unification *) + +Goal exists e, (fix foo (n : nat) : nat := match n with O => e | S n' => foo n' end) + = (fix foo (n : nat) : nat := match n with O => O | S n' => foo n' end). +Proof. + eexists. + reflexivity. +Qed. + +CoInductive stream := cons : nat -> stream -> stream. + +Goal exists e, (cofix foo := cons e foo) = (cofix foo := cons 0 foo). +Proof. + eexists. + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_7068.v b/test-suite/bugs/closed/bug_7068.v new file mode 100644 index 0000000000..9fadb195bf --- /dev/null +++ b/test-suite/bugs/closed/bug_7068.v @@ -0,0 +1,6 @@ +(* These tests are only about a subset of #7068 *) +(* The original issue is still open *) + +Inductive foo : let T := Type in T := . +Definition bob1 := Eval vm_compute in foo_rect. +Definition bob2 := Eval native_compute in foo_rect. diff --git a/test-suite/bugs/closed/bug_7076.v b/test-suite/bugs/closed/bug_7076.v new file mode 100644 index 0000000000..0abc88c282 --- /dev/null +++ b/test-suite/bugs/closed/bug_7076.v @@ -0,0 +1,4 @@ +(* These calls were raising an anomaly at some time *) +Inductive A : nat -> id (nat->Type) := . +Eval vm_compute in fun x => match x in A y z return y = z with end. +Eval native_compute in fun x => match x in A y z return y = z with end. diff --git a/test-suite/bugs/closed/bug_7092.v b/test-suite/bugs/closed/bug_7092.v new file mode 100644 index 0000000000..d90de8b932 --- /dev/null +++ b/test-suite/bugs/closed/bug_7092.v @@ -0,0 +1,70 @@ +(* Examples matching fix/cofix in Ltac pattern-matching *) + +Goal True. +lazymatch (eval cbv delta [Nat.add] in Nat.add) with +| (fix F (n : nat) (v : ?A) {struct n} : @?P n v + := match n with + | O => @?O_case v + | S n' => @?S_case n' v F + end) + => + unify A nat; + unify P (fun _ _ : nat => nat); + unify O_case (fun v : nat => v); + unify S_case (fun (p : nat) (m : nat) (add : nat -> nat -> nat) + => S (add p m)) + end. +Abort. + +Fixpoint f l n := match n with 0 => 0 | S n => g n (cons n l) end +with g n l := match n with 0 => 1 | S n => f (cons 0 l) n end. + +Goal True. + +lazymatch (eval cbv delta [f] in f) with +| fix myf (l : ?L) (n : ?N) {struct n} : nat := + match n as _ with + | 0 => ?Z + | S n0 => @?S myf myg n0 l + end + with myg (n' : ?N') (l' : ?L') {struct n'} : nat := + match n' as _ with + | 0 => ?Z' + | S n0' => @?S' myf myg n0' l' + end + for myf => + unify L (list nat); + unify L' (list nat); + unify N nat; + unify N' nat; + unify Z 0; + unify Z' 1; + unify S (fun (f : L -> N -> nat) (g : N -> L -> nat) n l => g n (cons n l)); + unify S' (fun (f : L -> N -> nat) (g : N -> L -> nat) (n:N) l => f (cons 0 l) n) +end. + +Abort. + +CoInductive S1 := C1 : nat -> S2 -> S1 with S2 := C2 : bool -> S1 -> S2. + +CoFixpoint f' n l := C1 n (g' (cons n l) n n) +with g' l n p := C2 true (f' (S n) l). + +Goal True. + +lazymatch (eval cbv delta [f'] in f') with +| cofix myf (n : ?N) (l : ?L) : ?T := @?X n g l + with g (l' : ?L') (n' : ?N') (p' : ?N'') : ?T' := @?X' n' myf l' + for myf => + unify L (list nat); + unify L' (list nat); + unify N nat; + unify N' nat; + unify N'' nat; + unify T S1; + unify T' S2; + unify X (fun n g l => C1 n (g (cons n l) n n)); + unify X' (fun n f (l : list nat) => C2 true (f (S n) l)) +end. + +Abort. diff --git a/test-suite/bugs/closed/bug_7113.v b/test-suite/bugs/closed/bug_7113.v new file mode 100644 index 0000000000..976e60f20c --- /dev/null +++ b/test-suite/bugs/closed/bug_7113.v @@ -0,0 +1,10 @@ +Require Import Program.Tactics. +Section visibility. + + (* used to anomaly *) + Program Let Fixpoint ev' (n : nat) : bool := _. + Next Obligation. exact true. Qed. + + Check ev'. +End visibility. +Fail Check ev'. diff --git a/test-suite/bugs/closed/bug_7195.v b/test-suite/bugs/closed/bug_7195.v new file mode 100644 index 0000000000..ea97747ac9 --- /dev/null +++ b/test-suite/bugs/closed/bug_7195.v @@ -0,0 +1,12 @@ +(* A disjoint-names condition was missing when matching names in Ltac + pattern-matching *) + +Goal True. + let x := (eval cbv beta zeta in (fun P => let Q := P in fun P => P + Q)) in + unify x (fun a b => b + a); (* success *) + let x' := lazymatch x with + | (fun (a : ?A) (b : ?B) => ?k) + => constr:(fun (a : A) (b : B) => k) + end in + unify x x'. +Abort. diff --git a/test-suite/bugs/closed/bug_7333.v b/test-suite/bugs/closed/bug_7333.v new file mode 100644 index 0000000000..fba5b9029d --- /dev/null +++ b/test-suite/bugs/closed/bug_7333.v @@ -0,0 +1,39 @@ +Module Example1. + +CoInductive wrap : Type := + | item : unit -> wrap. + +Definition extract (t : wrap) : unit := +match t with +| item x => x +end. + +CoFixpoint close u : unit -> wrap := +match u with +| tt => item +end. + +Definition table : wrap := close tt tt. + +Eval vm_compute in (extract table). +Eval vm_compute in (extract table). + +End Example1. + +Module Example2. + +Set Primitive Projections. +CoInductive wrap : Type := + item { extract : unit }. + +CoFixpoint close u : unit -> wrap := +match u with +| tt => item +end. + +Definition table : wrap := close tt tt. + +Eval vm_compute in (extract table). +Eval vm_compute in (extract table). + +End Example2. diff --git a/test-suite/bugs/closed/bug_7392.v b/test-suite/bugs/closed/bug_7392.v new file mode 100644 index 0000000000..cf465c6588 --- /dev/null +++ b/test-suite/bugs/closed/bug_7392.v @@ -0,0 +1,9 @@ +Inductive R : nat -> Prop := ER : forall n, R n -> R (S n). + +Goal (forall (n : nat), R n -> False) -> True -> False. +Proof. +intros H0 H1. +eapply H0. +clear H1. +apply ER. +simpl. diff --git a/test-suite/bugs/closed/bug_7421.v b/test-suite/bugs/closed/bug_7421.v new file mode 100644 index 0000000000..afcdd35fcc --- /dev/null +++ b/test-suite/bugs/closed/bug_7421.v @@ -0,0 +1,39 @@ + + +Universe i j. + +Goal False. +Proof. + Check Type@{i} : Type@{j}. + Fail constr_eq_strict Type@{i} Type@{j}. + assert_succeeds constr_eq Type@{i} Type@{j}. (* <- i=j is forgotten after assert_succeeds *) + Fail constr_eq_strict Type@{i} Type@{j}. + + constr_eq Type@{i} Type@{j}. (* <- i=j is retained *) + constr_eq_strict Type@{i} Type@{j}. + Fail Check Type@{i} : Type@{j}. + + Fail constr_eq Prop Set. + Fail constr_eq Prop Type. + + Fail constr_eq_strict Type Type. + constr_eq Type Type. + + constr_eq_strict Set Set. + constr_eq Set Set. + constr_eq Prop Prop. + + let x := constr:(Type) in constr_eq_strict x x. + let x := constr:(Type) in constr_eq x x. + + Fail lazymatch type of prod with + | ?A -> ?B -> _ => constr_eq_strict A B + end. + lazymatch type of prod with + | ?A -> ?B -> _ => constr_eq A B + end. + lazymatch type of prod with + | ?A -> ?B -> ?C => constr_eq A C + end. + +Abort. diff --git a/test-suite/bugs/closed/bug_7462.v b/test-suite/bugs/closed/bug_7462.v new file mode 100644 index 0000000000..40ca39e38a --- /dev/null +++ b/test-suite/bugs/closed/bug_7462.v @@ -0,0 +1,13 @@ +(* Adding an only-printing notation should not override existing + interpretations for the same notation. *) + +Notation "$ x" := (@id nat x) (only parsing, at level 0). +Notation "$ x" := (@id bool x) (only printing, at level 0). +Check $1. (* Was: Error: Unknown interpretation for notation "$ _". *) + +(* Adding an only-printing notation should not let believe + that a parsing rule has been given *) + +Notation "$ x" := (@id bool x) (only printing, at level 0). +Notation "$ x" := (@id nat x) (only parsing, at level 0). +Check $1. (* Was: Error: Syntax Error: Lexer: Undefined token *) diff --git a/test-suite/bugs/closed/bug_7554.v b/test-suite/bugs/closed/bug_7554.v new file mode 100644 index 0000000000..12b0aa2cb5 --- /dev/null +++ b/test-suite/bugs/closed/bug_7554.v @@ -0,0 +1,12 @@ +Require Import Coq.Program.Tactics. + +(* these should not result in anomalies *) + +Fail Program Lemma foo: + forall P, forall H, forall (n:nat), P n. + +Fail Program Lemma foo: + forall a (P : list a -> Prop), forall H, forall (n:list a), P n. + +Fail Program Lemma foo: + forall (a : Type) (P : list a -> Prop), forall H, forall (n:list a), P n. diff --git a/test-suite/bugs/closed/bug_7615.v b/test-suite/bugs/closed/bug_7615.v new file mode 100644 index 0000000000..cd8c4ad7df --- /dev/null +++ b/test-suite/bugs/closed/bug_7615.v @@ -0,0 +1,19 @@ +Set Universe Polymorphism. + +Module Type S. +Parameter Inline T@{i} : Type@{i+1}. +End S. + +Module F (X : S). +Definition X@{j i} : Type@{j} := X.T@{i}. +End F. + +Module M. +Definition T@{i} := Type@{i}. +End M. + +Module N := F(M). + +Require Import Hurkens. + +Fail Definition eqU@{i j} : @eq Type@{j} N.X@{i Set} Type@{i} := eq_refl. diff --git a/test-suite/bugs/closed/bug_7631.v b/test-suite/bugs/closed/bug_7631.v new file mode 100644 index 0000000000..34eb8b8676 --- /dev/null +++ b/test-suite/bugs/closed/bug_7631.v @@ -0,0 +1,21 @@ +Module NamedContext. + +Definition foo := true. + +Section Foo. + +Let bar := foo. + +Eval native_compute in bar. + +End Foo. + +End NamedContext. + +Module RelContext. + +Definition foo := true. + +Definition bar (x := foo) := Eval native_compute in x. + +End RelContext. diff --git a/test-suite/bugs/closed/bug_7695.v b/test-suite/bugs/closed/bug_7695.v new file mode 100644 index 0000000000..42bdb076b6 --- /dev/null +++ b/test-suite/bugs/closed/bug_7695.v @@ -0,0 +1,20 @@ +Require Import Hurkens. + +Universes i j k. +Module Type T. + Parameter T1 : Type@{i+1}. + Parameter e : Type@{j} = T1 : Type@{k}. +End T. + +Module M. + Definition T1 := Type@{j}. + Definition e : Type@{j} = T1 : Type@{k} := eq_refl. +End M. + +Module F (A:T). + Definition bad := TypeNeqSmallType.paradox _ A.e. +End F. + +Set Printing Universes. +Fail Module X := F M. +(* Universe inconsistency. Cannot enforce j <= i because i < Coq.Logic.Hurkens.105 = j. *) diff --git a/test-suite/bugs/closed/bug_7700.v b/test-suite/bugs/closed/bug_7700.v new file mode 100644 index 0000000000..56f5481baa --- /dev/null +++ b/test-suite/bugs/closed/bug_7700.v @@ -0,0 +1,9 @@ +(* Abbreviations to section variables were not located *) +Section foo. + Let x := Set. + Notation y := x. + Check y. + Variable x' : Set. + Notation y' := x'. + Check y'. +End foo. diff --git a/test-suite/bugs/closed/bug_7712.v b/test-suite/bugs/closed/bug_7712.v new file mode 100644 index 0000000000..a4e9697fad --- /dev/null +++ b/test-suite/bugs/closed/bug_7712.v @@ -0,0 +1,4 @@ +(* This used to raise an anomaly *) + +Fail Reserved Notation "'[tele_arg' x ';' .. ';' z ]" + (format "[tele_arg '[hv' x .. z ']' ]"). diff --git a/test-suite/bugs/closed/bug_7723.v b/test-suite/bugs/closed/bug_7723.v new file mode 100644 index 0000000000..2162901231 --- /dev/null +++ b/test-suite/bugs/closed/bug_7723.v @@ -0,0 +1,58 @@ +Set Universe Polymorphism. + +Module Segfault. + +Inductive decision_tree : Type := . + +Fixpoint first_satisfying_helper {A B} (f : A -> option B) (ls : list A) : option B + := match ls with + | nil => None + | cons x xs + => match f x with + | Some v => Some v + | None => first_satisfying_helper f xs + end + end. + +Axiom admit : forall {T}, T. +Definition dtree4 : option decision_tree := + match first_satisfying_helper (fun pat : nat => Some pat) (cons 0 nil) + with + | Some _ => admit + | None => admit + end +. +Definition dtree'' := Eval vm_compute in dtree4. (* segfault *) + +End Segfault. + +Module OtherExample. + +Definition bar@{i} := Type@{i}. +Definition foo@{i j} (x y z : nat) := + @id Type@{j} bar@{i}. +Eval vm_compute in foo. + +End OtherExample. + +Module LocalClosure. + +Definition bar@{i} := Type@{i}. + +Definition foo@{i j} (x y z : nat) := + @id (nat -> Type@{j}) (fun _ => Type@{i}). +Eval vm_compute in foo. + +End LocalClosure. + +Require Import Hurkens. +Polymorphic Inductive unit := tt. + +Polymorphic Definition foo := + let x := id tt in (x, x, Type). + +Lemma bad : False. + refine (TypeNeqSmallType.paradox (snd foo) _). + vm_compute. + Fail reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_7754.v b/test-suite/bugs/closed/bug_7754.v new file mode 100644 index 0000000000..229df93773 --- /dev/null +++ b/test-suite/bugs/closed/bug_7754.v @@ -0,0 +1,21 @@ + +Set Universe Polymorphism. + +Module OK. + + Inductive one@{i j} : Type@{i} := + with two : Type@{j} := . + Check one@{Set Type} : Set. + Fail Check two@{Set Type} : Set. + +End OK. + +Module Bad. + + Fail Inductive one := + with two@{i +} : Type@{i} := . + + Fail Inductive one@{i +} := + with two@{i +} := . + +End Bad. diff --git a/test-suite/bugs/closed/bug_7779.v b/test-suite/bugs/closed/bug_7779.v new file mode 100644 index 0000000000..78936b5958 --- /dev/null +++ b/test-suite/bugs/closed/bug_7779.v @@ -0,0 +1,15 @@ +(* Checking that the "in" clause takes the "eqn" clause into account *) + +Definition test (x: nat): {y: nat | False }. Admitted. + +Parameter x: nat. +Parameter z: nat. + +Goal + proj1_sig (test x) = z -> + False. +Proof. + intro H. + destruct (test x) eqn:Heqs in H. + change (test x = exist (fun _ : nat => False) x0 f) in Heqs. (* Check it has the expected statement *) +Abort. diff --git a/test-suite/bugs/closed/bug_7780.v b/test-suite/bugs/closed/bug_7780.v new file mode 100644 index 0000000000..2318f4d6ec --- /dev/null +++ b/test-suite/bugs/closed/bug_7780.v @@ -0,0 +1,16 @@ +(* A lift was missing in expanding aliases under binders for unification *) + +(* Below, the lift was missing while expanding the reference to + [mkcons] in [?N] which was under binder [arg] *) + +Goal forall T (t : T) (P P0 : T -> Set), option (option (list (P0 t)) -> option (list (P t))). + intros ????. + refine (Some + (fun rls + => let mkcons := ?[M] in + let default arg := ?[N] in + match rls as rls (* 2 *) return option (list (P ?[O])) with + | Some _ => None + | None => None + end)). +Abort. diff --git a/test-suite/bugs/closed/bug_7795.v b/test-suite/bugs/closed/bug_7795.v new file mode 100644 index 0000000000..5db0f81cc5 --- /dev/null +++ b/test-suite/bugs/closed/bug_7795.v @@ -0,0 +1,65 @@ + + +Definition fwd (b: bool) A (e2: A): A. Admitted. + +Ltac destruct_refinement_aux T := + let m := fresh "mres" in + let r := fresh "r" in + let P := fresh "P" in + pose T as m; + destruct m as [ r P ]. + +Ltac destruct_refinement := + match goal with + | |- context[proj1_sig ?T] => destruct_refinement_aux T + end. + +Ltac t_base := discriminate || destruct_refinement. + + +Inductive List (T: Type) := +| Cons_construct: T -> List T -> List T +| Nil_construct: List T. + +Definition t (T: Type): List T. Admitted. +Definition size (T: Type) (src: List T): nat. Admitted. +Definition filter1_rt1_type (T: Type): Type := { res: List T | false = true }. +Definition filter1 (T: Type): filter1_rt1_type T. Admitted. + +Definition hh_1: + forall T : Type, + (forall (T0 : Type), + False -> filter1_rt1_type T0) -> + False. +Admitted. + +Definition hh_2: + forall (T : Type), + filter1_rt1_type T -> + filter1_rt1_type T. +Admitted. + +Definition hh: + forall (T : Type) (f1 : forall (T0 : Type), False -> filter1_rt1_type T0), + fwd + (Nat.leb + (size T + (fwd false (List T) + (fwd false (List T) + (proj1_sig + (hh_2 T + (f1 T (hh_1 T f1))))))) 0) bool + false = true. +Admitted. + +Set Program Mode. (* removing this line prevents the bug *) +Obligation Tactic := repeat t_base. + +Goal + forall T (h17: T), + filter1 T = + exist + _ + (Nil_construct T) + (hh T (fun (T : Type) (_ : False) => filter1 T)). +Abort. diff --git a/test-suite/bugs/closed/bug_7811.v b/test-suite/bugs/closed/bug_7811.v new file mode 100644 index 0000000000..fee330f22d --- /dev/null +++ b/test-suite/bugs/closed/bug_7811.v @@ -0,0 +1,114 @@ +(* -*- mode: coq; coq-prog-args: ("-emacs" "-top" "atomic" "-Q" "." "iris" "-R" "." "stdpp") -*- *) +(* File reduced by coq-bug-finder from original input, then from 140 lines to 26 lines, then from 141 lines to 27 lines, then from 142 lines to 27 lines, then from 272 lines to 61 lines, then from 291 lines to 94 lines, then from 678 lines to 142 lines, then from 418 lines to 161 lines, then from 538 lines to 189 lines, then from 840 lines to 493 lines, then from 751 lines to 567 lines, then from 913 lines to 649 lines, then from 875 lines to 666 lines, then from 784 lines to 568 lines, then from 655 lines to 173 lines, then from 317 lines to 94 lines, then from 172 lines to 86 lines, then from 102 lines to 86 lines, then from 130 lines to 86 lines, then from 332 lines to 112 lines, then from 279 lines to 111 lines, then from 3996 lines to 5697 lines, then from 153 lines to 117 lines, then from 146 lines to 108 lines, then from 124 lines to 108 lines *) +(* coqc version 8.8.0 (May 2018) compiled on May 2 2018 16:49:46 with OCaml 4.02.3 + coqtop version 8.8.0 (May 2018) *) + +(* This was triggering a "Not_found" at the time of printing/showing the goal *) + +Require Coq.Unicode.Utf8. + +Notation "t $ r" := (t r) + (at level 65, right associativity, only parsing). + +Inductive tele : Type := + | TeleO : tele + | TeleS {X} (binder : X -> tele) : tele. + +Fixpoint tele_fun (TT : tele) (T : Type) : Type := + match TT with + | TeleO => T + | TeleS b => forall x, tele_fun (b x) T + end. + +Inductive tele_arg : tele -> Type := +| TargO : tele_arg TeleO +| TargS {X} {binder} (x : X) : tele_arg (binder x) -> tele_arg (TeleS binder). + +Axiom tele_app : forall {TT : tele} {T} (f : tele_fun TT T), tele_arg TT -> T. + +Coercion tele_arg : tele >-> Sortclass. + +Inductive val := + | LitV + | PairV (v1 v2 : val) + | InjLV (v : val) + | InjRV (v : val). +Axiom coPset : Set. +Axiom atomic_update : forall {PROP : Type} {TA TB : tele}, coPset -> coPset -> (TA -> PROP) -> (TA -> TB -> PROP) -> (TA -> TB -> PROP) -> PROP. +Import Coq.Unicode.Utf8. +Notation "'AU' '<<' ∀ x1 .. xn , α '>>' @ Eo , Ei '<<' β , 'COMM' Φ '>>'" := + (atomic_update (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) + (TB:=TeleO) + Eo Ei + (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ + λ x1, .. (λ xn, α) ..) + (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ + λ x1, .. (λ xn, tele_app (TT:=TeleO) β) .. ) + (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ + λ x1, .. (λ xn, tele_app (TT:=TeleO) Φ) .. ) + ) + (at level 20, Eo, Ei, α, β, Φ at level 200, x1 binder, xn binder, + format "'[ ' 'AU' '<<' ∀ x1 .. xn , α '>>' '/' @ Eo , Ei '/' '[ ' '<<' β , '/' COMM Φ '>>' ']' ']'") : bi_scope. + +Axiom ident : Set. +Inductive env (A : Type) : Type := Enil : env A | Esnoc : env A → ident → A → env A. +Record envs (PROP : Type) : Type + := Envs { env_spatial : env PROP }. +Axiom positive : Set. +Axiom Qp : Set. +Axiom one : positive. +Goal forall (T : Type) (T0 : forall _ : T, Type) (P : Set) + (u : T) (γs : P) (Q : T0 u) (Φ o : forall _ : val, T0 u) + (stack_content0 : forall (_ : P) (_ : list val), T0 u) + (c c0 : coPset) (l : forall (A : Type) (_ : list A), list A) + (e0 : forall (_ : env (T0 u)) (_ : positive), envs (T0 u)) + (i0 : ident) (o1 : forall (_ : Qp) (_ : val), T0 u) + (b0 : forall _ : env (T0 u), T0 u) (P0 : forall _ : T0 u, Type) + (u0 : forall (_ : T0 u) (_ : T0 u), T0 u), + P0 + (@atomic_update (T0 u) + (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO))) TeleO c c0 + (@tele_app (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO))) + (T0 u) (fun (v : val) (q : Qp) => o1 q v)) + (@tele_app (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO))) + (forall _ : tele_arg TeleO, T0 u) + (fun (v : val) (q : Qp) => @tele_app TeleO (T0 u) (o1 q v))) + (@tele_app (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO))) + (forall _ : tele_arg TeleO, T0 u) + (fun (x : val) (_ : Qp) => + @tele_app TeleO (T0 u) + (u0 + (b0 + match + e0 + (@Esnoc (T0 u) (@Enil (T0 u)) i0 + (@atomic_update (T0 u) + (@TeleS (list val) (fun _ : list val => TeleO)) TeleO + c c0 + (@tele_app + (@TeleS (list val) (fun _ : list val => TeleO)) + (T0 u) (fun l0 : list val => stack_content0 γs l0)) + (@tele_app + (@TeleS (list val) (fun _ : list val => TeleO)) + (forall _ : tele_arg TeleO, T0 u) + (fun l0 : list val => + @tele_app TeleO (T0 u) + (stack_content0 γs (l val l0)))) + (@tele_app + (@TeleS (list val) (fun _ : list val => TeleO)) + (forall _ : tele_arg TeleO, T0 u) + (fun x1 : list val => + @tele_app TeleO (T0 u) + (u0 Q + (Φ + match x1 return val with + | nil => InjLV LitV + | cons v _ => InjRV v + end)))))) one + return (env (T0 u)) + with + | Envs _ env_spatial0 => env_spatial0 + end) (o x))))) +. + Show. +Abort. diff --git a/test-suite/bugs/closed/bug_7854.v b/test-suite/bugs/closed/bug_7854.v new file mode 100644 index 0000000000..ab1a29b632 --- /dev/null +++ b/test-suite/bugs/closed/bug_7854.v @@ -0,0 +1,10 @@ +Set Primitive Projections. + +CoInductive stream (A : Type) := cons { + hd : A; + tl : stream A; +}. + +CoFixpoint const {A} (x : A) := cons A x (const x). + +Check (@eq_refl _ (const tt) <<: tl unit (const tt) = const tt). diff --git a/test-suite/bugs/closed/bug_7867.v b/test-suite/bugs/closed/bug_7867.v new file mode 100644 index 0000000000..d0c7902756 --- /dev/null +++ b/test-suite/bugs/closed/bug_7867.v @@ -0,0 +1,4 @@ +(* Was a printer anomaly due to an internal lambda with no binders *) + +Class class := { foo : nat }. +Fail Instance : class := { foo := 0 ; bar := 0 }. diff --git a/test-suite/bugs/closed/bug_7900.v b/test-suite/bugs/closed/bug_7900.v new file mode 100644 index 0000000000..583ef0ef3b --- /dev/null +++ b/test-suite/bugs/closed/bug_7900.v @@ -0,0 +1,53 @@ +Require Import Coq.Program.Program. +(* Set Universe Polymorphism. *) +Set Printing Universes. + +Axiom ALL : forall {T:Prop}, T. + +Inductive Expr : Set := E (a : Expr). + +Parameter Value : Set. + +Fixpoint eval (e: Expr): Value := + match e with + | E a => eval a + end. + +Class Quote (n: Value) : Set := + { quote: Expr + ; eval_quote: eval quote = n }. + +Program Definition quote_mult n + `{!Quote n} : Quote n := + {| quote := E (quote (n:=n)) |}. + +Set Printing Universes. +Next Obligation. +Proof. + Show Universes. + destruct Quote0 as [q eq]. + Show Universes. + rewrite <- eq. + clear n eq. + Show Universes. + apply ALL. + Show Universes. +Qed. +Print quote_mult_obligation_1. +(* quote_mult_obligation_1@{} = +let Top_internal_eq_rew_dep := + fun (A : Type@{Coq.Init.Logic.8}) (x : A) (P : forall a : A, x = a -> Type@{Top.5} (* <- XXX *)) + (f : P x eq_refl) (y : A) (e : x = y) => + match e as e0 in (_ = y0) return (P y0 e0) with + | eq_refl => f + end in +fun (n : Value) (Quote0 : Quote n) => +match Quote0 as q return (eval quote = n) with +| {| quote := q; eval_quote := eq0 |} => + Top_internal_eq_rew_dep Value (eval q) (fun (n0 : Value) (eq1 : eval q = n0) => eval quote = n0) + ALL n eq0 +end + : forall (n : Value) (Quote0 : Quote n), eval (E quote) = n + +quote_mult_obligation_1 is universe polymorphic +*) diff --git a/test-suite/bugs/closed/bug_7903.v b/test-suite/bugs/closed/bug_7903.v new file mode 100644 index 0000000000..55c7ee99a7 --- /dev/null +++ b/test-suite/bugs/closed/bug_7903.v @@ -0,0 +1,4 @@ +(* Slightly improving interpretation of Ltac subterms in notations *) + +Notation bar x f := (let z := ltac:(exact 1) in (fun x : nat => f)). +Check bar x (x + x). diff --git a/test-suite/bugs/closed/bug_7967.v b/test-suite/bugs/closed/bug_7967.v new file mode 100644 index 0000000000..2c8855fd54 --- /dev/null +++ b/test-suite/bugs/closed/bug_7967.v @@ -0,0 +1,2 @@ +Set Universe Polymorphism. +Inductive A@{} : Set := B : ltac:(let y := constr:(Type) in exact nat) -> A. diff --git a/test-suite/bugs/closed/bug_8004.v b/test-suite/bugs/closed/bug_8004.v new file mode 100644 index 0000000000..818639997a --- /dev/null +++ b/test-suite/bugs/closed/bug_8004.v @@ -0,0 +1,47 @@ +Require Export Coq.Program.Tactics Coq.Classes.SetoidTactics Coq.Classes.CMorphisms . + +Set Universe Polymorphism. + +Delimit Scope category_theory_scope with category_theory. +Open Scope category_theory_scope. + +Infix "∧" := prod (at level 80, right associativity) : category_theory_scope. + +Class Setoid A := { + equiv : crelation A; + setoid_equiv :> Equivalence equiv +}. + +Notation "f ≈ g" := (equiv f g) (at level 79) : category_theory_scope. + +Open Scope list_scope. + +Generalizable All Variables. + +Fixpoint list_equiv `{Setoid A} (xs ys : list A) : Type := + match xs, ys with + | nil, nil => True + | x :: xs, y :: ys => x ≈ y ∧ list_equiv xs ys + | _, _ => False + end. + +Axiom proof_admitted : False. +Tactic Notation "admit" := abstract case proof_admitted. + +Program Instance list_equivalence `{Setoid A} : Equivalence list_equiv. +Next Obligation. + repeat intro. + induction x; simpl; split; auto. + reflexivity. +Qed. +Next Obligation. + repeat intro. + generalize dependent y. + induction x, y; simpl; intros; auto. + destruct X; split. + now symmetry. + intuition. +Qed. +Next Obligation. +admit. +Defined. diff --git a/test-suite/bugs/closed/bug_8081.v b/test-suite/bugs/closed/bug_8081.v new file mode 100644 index 0000000000..0f2501aaa8 --- /dev/null +++ b/test-suite/bugs/closed/bug_8081.v @@ -0,0 +1,4 @@ +Section foo. +End foo. +Section foo. +End foo. diff --git a/test-suite/bugs/closed/bug_808_2411.v b/test-suite/bugs/closed/bug_808_2411.v new file mode 100644 index 0000000000..1169b2036b --- /dev/null +++ b/test-suite/bugs/closed/bug_808_2411.v @@ -0,0 +1,27 @@ +Section test. +Variable n:nat. +Lemma foo: 0 <= n. +Proof. +(* declaring an Axiom during a proof makes it immediatly + usable, juste as a full Definition. *) +Axiom bar : n = 1. +rewrite bar. +now apply le_S. +Qed. + +Lemma foo' : 0 <= n. +Proof. +(* Declaring an Hypothesis during a proof is ok, + but this hypothesis won't be usable by the current proof(s), + only by later ones. *) +Hypothesis bar' : n = 1. +Fail rewrite bar'. +Abort. + +Lemma foo'' : 0 <= n. +Proof. +rewrite bar'. +now apply le_S. +Qed. + +End test. diff --git a/test-suite/bugs/closed/bug_8106.v b/test-suite/bugs/closed/bug_8106.v new file mode 100644 index 0000000000..a711c5adef --- /dev/null +++ b/test-suite/bugs/closed/bug_8106.v @@ -0,0 +1,4 @@ +(* Was raising an anomaly "already assigned a level" on the second line *) + +Notation "c1 ; c2" := (c1 + c2) (only printing, at level 76, right associativity, c1 at level 76, c2 at level 76). +Notation "c1 ; c2" := (c1 + c2) (only parsing, at level 76, right associativity, c2 at level 76). diff --git a/test-suite/bugs/closed/bug_8119.v b/test-suite/bugs/closed/bug_8119.v new file mode 100644 index 0000000000..c6329a7328 --- /dev/null +++ b/test-suite/bugs/closed/bug_8119.v @@ -0,0 +1,46 @@ +Require Import Coq.Strings.String. + +Section T. + Eval vm_compute in let x := tt in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Eval vm_compute in let _ := Set in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Eval vm_compute in let _ := Prop in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) +End T. + +Section U0. + Let n : unit := tt. + Eval vm_compute in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) +End U0. + +Section S0. + Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". + Eval vm_compute in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) +End S0. + +Class T := { }. +Section S1. + Context {p : T}. + Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". + Eval vm_compute in _. +(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. +(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) +End S1. + +Class M := { m : Type }. +Section S2. + Context {p : M}. + Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". + Eval vm_compute in _. +(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) + Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort. +(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) +End S2. diff --git a/test-suite/bugs/closed/bug_8121.v b/test-suite/bugs/closed/bug_8121.v new file mode 100644 index 0000000000..99267612ca --- /dev/null +++ b/test-suite/bugs/closed/bug_8121.v @@ -0,0 +1,46 @@ +Require Import Coq.Strings.String. + +Section T. + Eval native_compute in let x := tt in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Eval native_compute in let _ := Set in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Eval native_compute in let _ := Prop in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) +End T. + +Section U0. + Let n : unit := tt. + Eval native_compute in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. native_compute. Abort. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) +End U0. + +Section S0. + Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". + Eval native_compute in _. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. native_compute. Abort. +(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *) +End S0. + +Class T := { }. +Section S1. + Context {p : T}. + Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". + Eval native_compute in _. +(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) + Goal exists tt : unit, tt = tt. eexists. native_compute. Abort. +(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) +End S1. + +Class M := { m : Type }. +Section S2. + Context {p : M}. + Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "". + Eval native_compute in _. +(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) + Goal exists tt : unit, tt = tt. eexists. native_compute. Abort. +(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *) +End S2. diff --git a/test-suite/bugs/closed/bug_8126.v b/test-suite/bugs/closed/bug_8126.v new file mode 100644 index 0000000000..f52dfc6b47 --- /dev/null +++ b/test-suite/bugs/closed/bug_8126.v @@ -0,0 +1,13 @@ +(* See also output test Notations4.v *) + +Inductive foo := tt. +Bind Scope foo_scope with foo. +Delimit Scope foo_scope with foo. +Notation "'HI'" := tt : foo_scope. +Definition myfoo (x : nat) (y : nat) (z : foo) := y. +Notation myfoo0 := (@myfoo 0). +Notation myfoo01 := (@myfoo0 1). +Check myfoo 0 1 HI. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo0 1 HI. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo01 tt. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo01 HI. (* was failing *) diff --git a/test-suite/bugs/closed/bug_8215.v b/test-suite/bugs/closed/bug_8215.v new file mode 100644 index 0000000000..c4b29a6354 --- /dev/null +++ b/test-suite/bugs/closed/bug_8215.v @@ -0,0 +1,14 @@ +(* Check that instances for local definitions in evars have compatible body *) +Goal False. +Proof. + pose (n := 1). + evar (m:nat). + subst n. + pose (n := 0). + Fail Check ?m. (* n cannot be reinterpreted with a value convertible to 1 *) + clearbody n. + Fail Check ?m. (* n cannot be reinterpreted with a value convertible to 1 *) + clear n. + pose (n := 0+1). + Check ?m. (* Should be ok *) +Abort. diff --git a/test-suite/bugs/closed/bug_8270.v b/test-suite/bugs/closed/bug_8270.v new file mode 100644 index 0000000000..f36f757f10 --- /dev/null +++ b/test-suite/bugs/closed/bug_8270.v @@ -0,0 +1,15 @@ +(* Don't do zeta in cbn when not asked for *) + +Goal let x := 0 in + let y := x in + y = 0. + (* We use "cofix" as an example because there are obviously no + cofixpoints in sight. This problem arises with any set of + reduction flags (not including zeta where the lets are of course reduced away) *) + cbn cofix. + intro x. + unfold x at 1. (* Should succeed *) + Undo 2. + cbn zeta. + Fail unfold x at 1. +Abort. diff --git a/test-suite/bugs/closed/bug_8288.v b/test-suite/bugs/closed/bug_8288.v new file mode 100644 index 0000000000..0350be9c06 --- /dev/null +++ b/test-suite/bugs/closed/bug_8288.v @@ -0,0 +1,7 @@ +Set Universe Polymorphism. +Set Printing Universes. + +Set Polymorphic Inductive Cumulativity. + +Inductive foo := C : (forall A : Type -> Type, A Type) -> foo. +(* anomaly invalid subtyping relation *) diff --git a/test-suite/bugs/closed/bug_8432.v b/test-suite/bugs/closed/bug_8432.v new file mode 100644 index 0000000000..844ee12668 --- /dev/null +++ b/test-suite/bugs/closed/bug_8432.v @@ -0,0 +1,39 @@ +Require Import Program.Tactics. + +Obligation Tactic := idtac. +Set Universe Polymorphism. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Inductive Empty : Type :=. +Inductive Unit : Type := tt. +Definition not (A : Type) := A -> Empty. + + Lemma nat_path_O_S (n : nat) (H : paths O (S n)) : Empty. + Proof. refine ( + match H in paths _ i return + match i with + | O => Unit + | S _ => Empty + end + with + | idpath _ => tt + end + ). Defined. + Lemma symmetry {A} (x y : A) (p : paths x y) : paths y x. + Proof. + destruct p. apply idpath. + Defined. + Lemma nat_path_S_O (n : nat) (H : paths (S n) O) : Empty. + Proof. eapply nat_path_O_S. exact (symmetry _ _ H). Defined. +Set Printing Universes. +Program Fixpoint succ_not_zero (n:nat) : not (paths (S n) 0) := +match n as n return not (paths (S n) 0) with +| 0 => nat_path_S_O _ +| S n' => let dummy := succ_not_zero n' in _ +end. +Next Obligation. + intros f _ n dummy H. exact (nat_path_S_O _ H). + Show Universes. +Defined. diff --git a/test-suite/bugs/closed/bug_8478.v b/test-suite/bugs/closed/bug_8478.v new file mode 100644 index 0000000000..8baaf8686a --- /dev/null +++ b/test-suite/bugs/closed/bug_8478.v @@ -0,0 +1,11 @@ +Set Universe Polymorphism. +Set Printing Universes. +Unset Strict Universe Declaration. + +Monomorphic Universe v. + +Section Foo. + Let bar := Type@{u}. + Fail Monomorphic Constraint bar.u < v. + +End Foo. (* was anomaly undeclared universe due to the constraint *) diff --git a/test-suite/bugs/closed/bug_8532.v b/test-suite/bugs/closed/bug_8532.v new file mode 100644 index 0000000000..00aa66e701 --- /dev/null +++ b/test-suite/bugs/closed/bug_8532.v @@ -0,0 +1,8 @@ +(* Checking Print Assumptions relatively to a bound module *) + +Module Type Typ. + Parameter Inline(10) t : Type. +End Typ. +Module Terms_mod (SetVars : Typ). +Print Assumptions SetVars.t. +End Terms_mod. diff --git a/test-suite/bugs/opened/1338.v-disabled b/test-suite/bugs/opened/1338.v-disabled deleted file mode 100644 index ab0f98202d..0000000000 --- a/test-suite/bugs/opened/1338.v-disabled +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Omega. - -Goal forall x, 0 <= x -> x <= 20 -> -x <> 0 - -> x <> 1 -> x <> 2 -> x <> 3 -> x <>4 -> x <> 5 -> x <> 6 -> x <> 7 -> x <> 8 --> x <> 9 -> x <> 10 - -> x <> 11 -> x <> 12 -> x <> 13 -> x <> 14 -> x <> 15 -> x <> 16 -> x <> 17 --> x <> 18 -> x <> 19 -> x <> 20 -> False. -Proof. - intros. - Fail omega. -Abort. diff --git a/test-suite/bugs/opened/1596.v b/test-suite/bugs/opened/1596.v deleted file mode 100644 index 820022d995..0000000000 --- a/test-suite/bugs/opened/1596.v +++ /dev/null @@ -1,260 +0,0 @@ -Require Import Relations. -Require Import FSets. -Require Import Arith. -Require Import Omega. - -Set Keyed Unification. - -Lemma Bool_elim_bool : forall (b:bool),b=true \/ b=false. - destruct b;try tauto. -Qed. - -Module OrderedPair (X:OrderedType) (Y:OrderedType) <: OrderedType with -Definition t := (X.t * Y.t)%type. - Definition t := (X.t * Y.t)%type. - - Definition eq (xy1:t) (xy2:t) := - let (x1,y1) := xy1 in - let (x2,y2) := xy2 in - (X.eq x1 x2) /\ (Y.eq y1 y2). - - Definition lt (xy1:t) (xy2:t) := - let (x1,y1) := xy1 in - let (x2,y2) := xy2 in - (X.lt x1 x2) \/ ((X.eq x1 x2) /\ (Y.lt y1 y2)). - - Lemma eq_refl : forall (x:t),(eq x x). - destruct x. - unfold eq. - split;[apply X.eq_refl | apply Y.eq_refl]. - Qed. - - Lemma eq_sym : forall (x y:t),(eq x y)->(eq y x). - destruct x;destruct y;unfold eq;intro. - elim H;clear H;intros. - split;[apply X.eq_sym | apply Y.eq_sym];trivial. - Qed. - - Lemma eq_trans : forall (x y z:t),(eq x y)->(eq y z)->(eq x z). - unfold eq;destruct x;destruct y;destruct z;intros. - elim H;clear H;intros. - elim H0;clear H0;intros. - split;[eapply X.eq_trans | eapply Y.eq_trans];eauto. - Qed. - - Lemma lt_trans : forall (x y z:t),(lt x y)->(lt y z)->(lt x z). - unfold lt;destruct x;destruct y;destruct z;intros. - case H;clear H;intro. - case H0;clear H0;intro. - left. - eapply X.lt_trans;eauto. - elim H0;clear H0;intros. - left. - case (X.compare t0 t4);trivial;intros. - generalize (X.eq_sym H0);intro. - generalize (X.eq_trans e H2);intro. - elim (X.lt_not_eq H H3). - generalize (X.lt_trans l H);intro. - generalize (X.eq_sym H0);intro. - elim (X.lt_not_eq H2 H3). - elim H;clear H;intros. - case H0;clear H0;intro. - left. - case (X.compare t0 t4);trivial;intros. - generalize (X.eq_sym H);intro. - generalize (X.eq_trans H2 e);intro. - elim (X.lt_not_eq H0 H3). - generalize (X.lt_trans H0 l);intro. - generalize (X.eq_sym H);intro. - elim (X.lt_not_eq H2 H3). - elim H0;clear H0;intros. - right. - split. - eauto. - eauto. - Qed. - - Lemma lt_not_eq : forall (x y:t),(lt x y)->~(eq x y). - unfold lt, eq;destruct x;destruct y;intro;intro. - elim H0;clear H0;intros. - case H. - intro. - apply (X.lt_not_eq H2 H0). - intro. - elim H2;clear H2;intros. - apply (Y.lt_not_eq H3 H1). - Qed. - - Definition compare : forall (x y:t),(Compare lt eq x y). - destruct x;destruct y. - case (X.compare t0 t2);intro. - apply LT. - left;trivial. - case (Y.compare t1 t3);intro. - apply LT. - right. - tauto. - apply EQ. - split;trivial. - apply GT. - right;auto. - apply GT. - left;trivial. - Defined. - - Definition eq_dec : forall (x y: t), { eq x y } + { ~ eq x y}. - Proof. - intros [xa xb] [ya yb]; simpl. - destruct (X.eq_dec xa ya). - destruct (Y.eq_dec xb yb). - + left; now split. - + right. now intros [eqa eqb]. - + right. now intros [eqa eqb]. - Defined. - - Hint Immediate eq_sym. - Hint Resolve eq_refl eq_trans lt_not_eq lt_trans. -End OrderedPair. - -Module MessageSpi. - Inductive message : Set := - | MNam : nat -> message. - - Definition t := message. - - Fixpoint message_lt (m n:message) {struct m} : Prop := - match (m,n) with - | (MNam n1,MNam n2) => n1 < n2 - end. - - Module Ord <: OrderedType with Definition t := message with Definition eq := -@eq message. - Definition t := message. - Definition eq := @eq message. - Definition lt := message_lt. - - Lemma eq_refl : forall (x:t),eq x x. - unfold eq;auto. - Qed. - - Lemma eq_sym : forall (x y:t),(eq x y )->(eq y x). - unfold eq;auto. - Qed. - - Lemma eq_trans : forall (x y z:t),(eq x y)->(eq y z)->(eq x z). - unfold eq;auto;intros;congruence. - Qed. - - Lemma lt_trans : forall (x y z:t),(lt x y)->(lt y z)->(lt x z). - unfold lt. - induction x;destruct y;simpl;try tauto;destruct z;try tauto;intros. - omega. - Qed. - - Lemma lt_not_eq : forall (x y:t),(lt x y)->~(eq x y). - unfold eq;unfold lt. - induction x;destruct y;simpl;try tauto;intro;red;intro;try (discriminate -H0);injection H0;intros. - elim (lt_irrefl n);try omega. - Qed. - - Definition compare : forall (x y:t),(Compare lt eq x y). - unfold lt, eq. - induction x;destruct y;intros;try (apply LT;simpl;trivial;fail);try -(apply -GT;simpl;trivial;fail). - case (lt_eq_lt_dec n n0);intros;try (case s;clear s;intros). - apply LT;trivial. - apply EQ;trivial. - rewrite e;trivial. - apply GT;trivial. - Defined. - - Definition eq_dec : forall (x y: t), { eq x y } + { ~ eq x y}. - Proof. - intros [i] [j]. unfold eq. - destruct (eq_nat_dec i j). - + left. now f_equal. - + right. intros meq; now inversion meq. - Defined. - - Hint Immediate eq_sym. - Hint Resolve eq_refl eq_trans lt_not_eq lt_trans. - End Ord. - - Theorem eq_dec : forall (m n:message),{m=n}+{~(m=n)}. - intros. - case (Ord.compare m n);intro;[right | left | right];try (red;intro). - elim (Ord.lt_not_eq m n);auto. - rewrite e;auto. - elim (Ord.lt_not_eq n m);auto. - Defined. -End MessageSpi. - -Module MessagePair := OrderedPair MessageSpi.Ord MessageSpi.Ord. - -Module Type Hedge := FSetInterface.S with Module E := MessagePair. - -Module A (H:Hedge). - Definition hedge := H.t. - - Definition message_relation := relation MessageSpi.message. - - Definition relation_of_hedge (h:hedge) (m n:MessageSpi.message) := H.In (m,n) -h. - - Inductive hedge_synthesis_relation (h:message_relation) : message_relation := - | SynInc : forall (m n:MessageSpi.message),(h m -n)->(hedge_synthesis_relation h m n). - - Fixpoint hedge_in_synthesis (h:hedge) (m:MessageSpi.message) -(n:MessageSpi.message) {struct m} : bool := - if H.mem (m,n) h - then true - else false. - - Definition hedge_synthesis_spec (h:hedge) := hedge_synthesis_relation -(relation_of_hedge h). - - Lemma hedge_in_synthesis_impl_hedge_synthesis_spec : forall (h:hedge),forall -(m n:MessageSpi.message),(hedge_in_synthesis h m n)=true->(hedge_synthesis_spec -h m n). - unfold hedge_synthesis_spec;unfold relation_of_hedge. - induction m;simpl;intro. - elim (Bool_elim_bool (H.mem (MessageSpi.MNam n,n0) h));intros. - apply SynInc;apply H.mem_2;trivial. - rewrite H in H0. (* !! possible here !! *) - discriminate H0. - Qed. -End A. - -Module B (H:Hedge). - Definition hedge := H.t. - - Definition message_relation := relation MessageSpi.t. - - Definition relation_of_hedge (h:hedge) (m n:MessageSpi.t) := H.In (m,n) h. - - Inductive hedge_synthesis_relation (h:message_relation) : message_relation := - | SynInc : forall (m n:MessageSpi.t),(h m n)->(hedge_synthesis_relation h m -n). - - Fixpoint hedge_in_synthesis (h:hedge) (m:MessageSpi.t) (n:MessageSpi.t) -{struct m} : bool := - if H.mem (m,n) h - then true - else false. - - Definition hedge_synthesis_spec (h:hedge) := hedge_synthesis_relation -(relation_of_hedge h). - - Lemma hedge_in_synthesis_impl_hedge_synthesis_spec : forall (h:hedge),forall -(m n:MessageSpi.t),(hedge_in_synthesis h m n)=true->(hedge_synthesis_spec h m -n). - unfold hedge_synthesis_spec;unfold relation_of_hedge. - induction m;simpl;intro. - elim (Bool_elim_bool (H.mem (MessageSpi.MNam n,n0) h));intros. - apply SynInc;apply H.mem_2;trivial. - rewrite H in H0. discriminate. (* !! impossible here !! *) - Qed. -End B. diff --git a/test-suite/bugs/opened/1615.v b/test-suite/bugs/opened/1615.v deleted file mode 100644 index 2825701410..0000000000 --- a/test-suite/bugs/opened/1615.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Omega. - -Lemma foo : forall n m : Z, (n >= 0)%Z -> (n * m >= 0)%Z -> (n <= n + n * m)%Z. -Proof. - intros. omega. -Qed. - -Lemma foo' : forall n m : nat, n <= n + n * m. -Proof. - intros. Fail omega. -Abort. - diff --git a/test-suite/bugs/opened/1671.v b/test-suite/bugs/opened/1671.v deleted file mode 100644 index b4e653f687..0000000000 --- a/test-suite/bugs/opened/1671.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Exemple soumis par Pierre Corbineau (bug #1671) *) - -CoInductive hdlist : unit -> Type := -| cons : hdlist tt -> hdlist tt. - -Variable P : forall bo, hdlist bo -> Prop. -Variable all : forall bo l, P bo l. - -Fail Definition F (l:hdlist tt) : P tt l := -match l in hdlist u return P u l with -| cons (cons l') => all tt _ -end. diff --git a/test-suite/bugs/opened/1811.v b/test-suite/bugs/opened/1811.v deleted file mode 100644 index 57c1744313..0000000000 --- a/test-suite/bugs/opened/1811.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Export Bool. - -Lemma neg2xor : forall b, xorb true b = negb b. -Proof. auto. Qed. - -Goal forall b1 b2, (negb b1 = b2) -> xorb true b1 = b2. -Proof. - intros b1 b2. - Fail rewrite neg2xor. -Abort. diff --git a/test-suite/bugs/opened/2572.v-disabled b/test-suite/bugs/opened/2572.v-disabled deleted file mode 100644 index 3f6c6a0d14..0000000000 --- a/test-suite/bugs/opened/2572.v-disabled +++ /dev/null @@ -1,187 +0,0 @@ -Require Import List. -Definition is_dec (P:Prop) := {P}+{~P}. -Definition eq_dec (T:Type) := forall (t1 t2:T), is_dec (t1=t2). - -Record Label : Type := mkLabel { - LabElem: Type; - LabProd: LabElem -> LabElem -> option LabElem; - LabBot: LabElem -> Prop; - LabError: LabElem -> Prop -}. - -Definition LProd (L1 L2: Label): Label := {| - LabElem := LabElem L1 * LabElem L2; - LabProd := fun lg ld => let (lg1,lg2) := lg in let (ld1,ld2) := ld in - match LabProd L1 lg1 ld1, LabProd L2 lg2 ld2 with - Some g, Some d => Some (g,d) - | _,_ => None - end; - LabBot l := let (l1,l2) := l in LabBot L1 l1 \/ LabBot L2 l2; - LabError l := let (l1,l2) := l in LabError L1 l1 \/ LabError L2 l2 -|}. - -Definition Lrestrict (L: Label) (S: LabElem L -> bool): Label := {| - LabElem := LabElem L; - LabProd l1 l2 := if andb (S l1) (S l2) then LabProd L l1 l2 else None; - LabBot l := LabBot L l; - LabError l := LabError L l -|}. - -Notation "l1 ^* l2" := (LProd l1 l2) (at level 50). - -Record LTS(L:Type): Type := mkLTS { - State: Type; - Init: State -> Prop; - Next: State -> L -> State -> Prop -}. -Implicit Arguments State. -Implicit Arguments Init. -Implicit Arguments Next. - -Definition sound L (S: LTS (LabElem L)): Prop := - forall s s' l, Next S s l s' -> ~LabError L l. - -Inductive PNext L (S1 S2:LTS (LabElem L)): State S1 * State S2 -> (LabElem L) -> State S1 * State S2 -> Prop := - LNext: forall s1 s2 l1 s'1, Next S1 s1 l1 s'1 -> (forall l2, LabProd L l1 l2 = None) -> - PNext L S1 S2 (s1,s2) l1 (s'1,s2) -| RNext: forall s1 s2 l2 s'2, (forall l1, LabProd L l1 l2 = None) -> Next S2 s2 l2 s'2 -> - PNext L S1 S2 (s1,s2) l2 (s1,s'2) -| SNext: forall s1 s2 l1 l2 l s'1 s'2, Next S1 s1 l1 s'1 -> Next S2 s2 l2 s'2 -> - Some l = LabProd L l1 l2 -> PNext L S1 S2 (s1,s2) l (s'1,s'2). - -Definition Produit (L:Label) (S1 S2: LTS (LabElem L)): LTS (LabElem L) := {| - State := State S1 * State S2; - Init := fun s => let (s1,s2) := s in Init S1 s1 /\ Init S2 s2; - Next :=PNext L S1 S2 -|}. - -Parameter Time: Type. -Parameter teq: forall t1 t2:Time, {t1=t2}+{t1<>t2}. - -Inductive TLabElem(L:Type): Type := - Tdiscrete: L -> TLabElem L -| Tdelay: Time -> TLabElem L -| Tbot: TLabElem L. - -Definition TLabel L: Label := {| - LabElem := TLabElem (LabElem L); - LabProd lt1 lt2 := - match lt1, lt2 with - Tdiscrete l1, Tdiscrete l2 => match (LabProd L l1 l2) with Some l => Some (Tdiscrete (LabElem L) l) | None => None end - | Tdelay t1, Tdelay t2 => if teq t1 t2 then Some (Tdelay (LabElem L) t1) else Some (Tbot (LabElem L)) - | _,_ => None - end; - LabBot lt := match lt with - Tdiscrete l => LabBot L l - | Tbot => True - | _ => False - end; - LabError lt := match lt with - Tdiscrete l => LabError L l - | _ => False - end - |}. - -Parameter Var: Type. -Parameter allv: forall P, (forall (v:Var), is_dec (P v)) -> is_dec (forall v, P v). -Parameter DType: Type. -Parameter Data: DType -> Type. -Parameter vtype: Var -> DType. -Parameter Deq: forall t (d1 d2: Data t), is_dec (d1=d2). - -Inductive Vctr(v:Var): Type := - Wctr: Data (vtype v) -> Vctr v -| Rctr: Data (vtype v) -> Vctr v -| Fctr: Vctr v -| Nctr: Vctr v. - -Definition isCmp v (c1 c2: Vctr v): Prop := - match c1,c2 with - Wctr _, Nctr => True - | Rctr _, Rctr _ => True - | Rctr _, Nctr => True - | Rctr _, Fctr => True - | Nctr, _ => True - | _,_ => False - end. - -Lemma isCmp_dec: forall v (c1 c2: Vctr v), is_dec (isCmp v c1 c2). -intros. -induction c1; induction c2; simpl; intros; try (left; tauto); try (right; tauto). -Qed. - -Definition Vprod v (c1 c2: Vctr v): (isCmp v c1 c2) -> Vctr v := - match c1,c2 return isCmp v c1 c2 -> Vctr v with - | Wctr d, Nctr => fun h => Wctr v d - | Rctr d1, Rctr d2 => fun h => if Deq (vtype v) d1 d2 then Rctr v d1 else Fctr v - | Rctr d1, Nctr => fun h => Rctr v d1 - | Rctr d1, Fctr => fun h => Fctr v - | Fctr, Rctr _ => fun h => Fctr v - | Fctr, Fctr => fun h => Fctr v - | Fctr, Nctr => fun h => Fctr v - | Nctr, c2 => fun h => c2 - | _,_ => fun h => match h with end - end. - -Inductive MLabElem: Type := - Mctr: (forall v, Vctr v) -> MLabElem -| Merr: MLabElem. - -Definition MProd (m1 m2: MLabElem): MLabElem := - match m1,m2 with - Mctr c1, Mctr c2 => match allv (fun v => isCmp v (c1 v) (c2 v)) (fun v => isCmp_dec v (c1 v) (c2 v)) with - left h => Mctr (fun v => Vprod v (c1 v) (c2 v) (h v)) - | _ => Merr - end - | _,_ => Merr - end. - -Definition MLabel: Label := {| - LabElem := MLabElem; - LabProd m1 m2 := Some (MProd m1 m2); - LabBot m := exists c, m = Mctr c /\ exists v, c v = Fctr v; - LabError m := m = Merr -|}. - -Parameter Chan: Type. -Parameter ch_eq: eq_dec Chan. - -Definition CLabel(S: Chan->bool): Label := {| - LabElem := Chan; - LabProd := fun c1 c2 => if ch_eq c1 c2 then if S c1 then Some c1 else None else None; - LabBot := fun _ => False; - LabError := fun _ => False -|}. - -Definition FLabel(S: Chan->bool): Label := - TLabel (CLabel S ^* MLabel ^* MLabel ^* MLabel). - -Definition FTS := LTS (LabElem (FLabel (fun _ => true))). -Check (fun S (T1 T2: FTS) => Produit (FLabel S) T1 T2). -(* -Definition PAR (S: Chan -> bool) (T1 T2: FTS): FTS. -unfold FTS in *; simpl in *. -apply (Produit (FLabel S)). -apply T1. -apply T2. -Defined. - -Definition PAR (S: Chan -> bool) (T1 T2: FTS): FTS := - Produit (FLabel S) T1 T2. -*) -Lemma FTSirrel (S: Chan -> bool): FTS = LTS (LabElem (FLabel S)). -Proof. - unfold FTS. - simpl. - reflexivity. -Qed. - -Definition PAR (S: Chan -> bool) (T1 T2: FTS): FTS. -revert T2; revert T1. -rewrite (FTSirrel S). -apply (Produit (FLabel S)). -Defined. - -Record HTTS: Type := mkHTTS { - -}. diff --git a/test-suite/bugs/opened/3010.v-disabled b/test-suite/bugs/opened/3010.v-disabled deleted file mode 100644 index f2906bd6a6..0000000000 --- a/test-suite/bugs/opened/3010.v-disabled +++ /dev/null @@ -1 +0,0 @@ -Definition em {A R} (k : forall s : sum A _, match s with inl x => R x | inr y => R end) := k (inr (fun x => k (inl x))). \ No newline at end of file diff --git a/test-suite/bugs/opened/3092.v b/test-suite/bugs/opened/3092.v deleted file mode 100644 index 9db21d156e..0000000000 --- a/test-suite/bugs/opened/3092.v +++ /dev/null @@ -1,9 +0,0 @@ -Fail Fixpoint le_pred (n1 n2 : nat) (H1 : n1 <= n2) : pred n1 <= pred n2 := - match H1 with - | le_n => le_n (pred _) - | le_S _ H2 => - match n2 with - | 0 => fun H3 => H3 - | S _ => le_S _ _ - end (le_pred _ _ H2) - end. diff --git a/test-suite/bugs/opened/3166.v b/test-suite/bugs/opened/3166.v deleted file mode 100644 index e1c29a954c..0000000000 --- a/test-suite/bugs/opened/3166.v +++ /dev/null @@ -1,83 +0,0 @@ -Set Asymmetric Patterns. - -Section eq. - Let A := { X : Type & X }. - Let B := (fun x : A => projT1 x). - Let T := (fun (a' : A) (b' : B a') => projT2 a' = b'). - Let T' := T. - Let t1T := (fun _ : A => unit). - Let f1 := (fun x (_ : t1T x) => projT2 x). - Let t1 := (fun x (y : t1T x) => @eq_refl (projT1 x) (projT2 x)). - Let t1T' := t1T. - Let f1' := f1. - Let t1' := t1. - - Theorem eq_matches_commute - a' b' (t' : T a' b') - (rta : forall b'', T' a' b'' -> A) - (rtb : forall b'' t'', B (rta b'' t'')) - (rt1 : forall y, T _ (rtb (f1' a' y) (@t1' a' y))) - (R : forall (b : B (rta b' t')), T _ b -> Type) - (r1 : forall y, R (f1 _ y) (@t1 _ y)) - : match - match t' as t0' in (@eq _ _ b0') return T (rta b0' t0') (rtb b0' t0') with - | eq_refl => rt1 tt - end - as t0 in (@eq _ _ b0) - return R b0 t0 - with - | eq_refl => r1 tt - end - = - match t' - as t0' in (@eq _ _ b0') - return (forall (R : forall (b : B (rta b0' t0')), T _ b -> Type) - (r1 : forall y, R (f1 _ y) (@t1 _ y)), - R _ (match t0' as t0'0 in (@eq _ _ b0'0) return T (rta b0'0 t0'0) (rtb b0'0 t0'0) with - | eq_refl => rt1 tt - end)) - with - | eq_refl => fun _ r1 => - match rt1 tt with - | eq_refl => r1 tt - end - end R r1. - Proof. - destruct t'; reflexivity. - Defined. - - Theorem eq_match_beta2 - a b (t : T a b) - X - (R : forall b' (t' : T a b'), X b' -> Type) - (r1 : forall y x, R _ (@t1 _ y) x) - x - : match t as t' in (@eq _ _ b') return forall x, R b' t' x with - | eq_refl => r1 tt - end (x b) - = - match t as t' in (@eq _ _ b') return R b' t' (x b') with - | eq_refl => r1 tt (x _) - end. - Proof. - destruct t; reflexivity. - Defined. -End eq. - -Definition typeof {T} (_ : T) := T. - -Eval compute in (eq_sym (eq_sym _)). -Goal forall T (x y : T) (p : x = y), True. - intros. - pose proof - (@eq_matches_commute - (existT (fun T => T) T x) y p - (fun b'' _ => existT (fun T => T) T b'') - (fun _ _ => x) - (fun _ => eq_refl) - (fun x' _ => x' = y) - (fun _ => eq_refl) - ) as H0. - compute in H0. - change (fun (x' : T) (_ : y = x') => x' = y) with ((fun y => fun (x' : T) (_ : y = x') => x' = y) y) in H0. - Fail pose proof (fun k => @eq_trans _ _ _ k H0). diff --git a/test-suite/bugs/opened/3186.v-disabled b/test-suite/bugs/opened/3186.v-disabled deleted file mode 100644 index d0bcb920cc..0000000000 --- a/test-suite/bugs/opened/3186.v-disabled +++ /dev/null @@ -1,4 +0,0 @@ -Fixpoint a (_:unit):= -match eq_refl with -|eq_refl => a -end. \ No newline at end of file diff --git a/test-suite/bugs/opened/3248.v b/test-suite/bugs/opened/3248.v deleted file mode 100644 index 33c408a28c..0000000000 --- a/test-suite/bugs/opened/3248.v +++ /dev/null @@ -1,17 +0,0 @@ -Ltac ret_and_left f := - let tac := ret_and_left in - let T := type of f in - lazymatch eval hnf in T with - | ?T' -> _ => - let ret := constr:(fun x' : T' => ltac:(tac (f x'))) in - exact ret - | ?T' => exact f - end. - -Goal forall A B : Prop, forall x y : A, True. -Proof. - intros A B x y. - pose (f := fun (x y : A) => conj x y). - pose (a := ltac:(ret_and_left f)). - Fail unify (a x y) (conj x y). -Abort. diff --git a/test-suite/bugs/opened/3277.v b/test-suite/bugs/opened/3277.v deleted file mode 100644 index 5f4231363a..0000000000 --- a/test-suite/bugs/opened/3277.v +++ /dev/null @@ -1,7 +0,0 @@ -Tactic Notation "evarr" open_constr(x) := let y := constr:(x) in exact y. - -Goal True. - evarr _. -Admitted. -Goal True. - Fail exact ltac:(evarr _). (* Error: Cannot infer this placeholder. *) diff --git a/test-suite/bugs/opened/3278.v b/test-suite/bugs/opened/3278.v deleted file mode 100644 index 1c6deae94b..0000000000 --- a/test-suite/bugs/opened/3278.v +++ /dev/null @@ -1,25 +0,0 @@ -Module a. - Check let x' := _ in - ltac:(exact x'). - - Notation foo x := (let x' := x in ltac:(exact x')). - - Fail Check foo _. (* Error: -Cannot infer an internal placeholder of type "Type" in environment: - -x' := ?42 : ?41 -. *) -End a. - -Module b. - Notation foo x := (let x' := x in let y := (ltac:(exact I) : True) in I). - Notation bar x := (let x' := x in let y := (I : True) in I). - - Check let x' := _ in ltac:(exact I). (* let x' := ?5 in I *) - Check bar _. (* let x' := ?9 in let y := I in I *) - Fail Check foo _. (* Error: -Cannot infer an internal placeholder of type "Type" in environment: - -x' := ?42 : ?41 -. *) -End b. diff --git a/test-suite/bugs/opened/3283.v b/test-suite/bugs/opened/3283.v deleted file mode 100644 index 3ab5416e8c..0000000000 --- a/test-suite/bugs/opened/3283.v +++ /dev/null @@ -1,28 +0,0 @@ -Notation "P |-- Q" := (@eq nat P Q) (at level 80, Q at level 41, no associativity) . -Notation "x &&& y" := (plus x y) (at level 40, left associativity, y at next level) . -Notation "'Ex' x , P " := (plus x P) (at level 65, x at level 99, P at level 80). - -(* Succeed *) -Check _ |-- _ &&& _ -> _. -Check _ |-- _ &&& (Ex _, _ ) -> _. -Check _ |-- (_ &&& Ex _, _ ) -> _. - -(* Why does this fail? *) -Fail Check _ |-- _ &&& Ex _, _ -> _. -(* The command has indeed failed with message: -=> Error: The term "Ex ?17, ?18" has type "nat" -which should be Set, Prop or Type. *) - -(* Just in case something is strange with -> *) -Notation "P ----> Q" := (P -> Q) (right associativity, at level 99, Q at next level). - -(* Succeed *) -Check _ |-- _ &&& _ ----> _. -Check _ |-- _ &&& (Ex _, _ ) ----> _. -Check _ |-- (_ &&& Ex _, _ ) ----> _. - -(* Why does this fail? *) -Fail Check _ |-- _ &&& Ex _, _ ----> _. -(* The command has indeed failed with message: -=> Error: The term "Ex ?31, ?32" has type "nat" -which should be Set, Prop or Type.*) diff --git a/test-suite/bugs/opened/3295.v b/test-suite/bugs/opened/3295.v deleted file mode 100644 index c09649de73..0000000000 --- a/test-suite/bugs/opened/3295.v +++ /dev/null @@ -1,104 +0,0 @@ -Require Export Morphisms Setoid. - -Class lops := lmk_ops { - car: Type; - weq: relation car -}. - -Arguments car : clear implicits. - -Coercion car: lops >-> Sortclass. - -Instance weq_Equivalence `{lops}: Equivalence weq. -Proof. -Admitted. - -Module lset. -Canonical Structure lset_ops A := lmk_ops (list A) (fun h k => True). -End lset. - -Class ops := mk_ops { - ob: Type; - mor: ob -> ob -> lops; - dot: forall n m p, mor n m -> mor m p -> mor n p -}. -Coercion mor: ops >-> Funclass. -Arguments ob : clear implicits. - -Instance dot_weq `{ops} n m p: Proper (weq ==> weq ==> weq) (dot n m p). -Proof. -Admitted. - -Section s. - -Import lset. - -Context `{X:lops} {I: Type}. - -Axiom sup : forall (f: I -> X) (J : list I), X. - -Global Instance sup_weq: Proper (pointwise_relation _ weq ==> weq ==> weq) sup. -Proof. -Admitted. - -End s. - -Axiom ord : forall (n : nat), Type. -Axiom seq : forall n, list (ord n). - -Infix "==" := weq (at level 79). -Infix "*" := (dot _ _ _) (left associativity, at level 40). - -Notation "∑_ ( i ∈ l ) f" := (@sup (mor _ _) _ (fun i => f) l) - (at level 41, f at level 41, i, l at level 50). - -Axiom dotxsum : forall `{X : ops} I J n m p (f: I -> X m n) (x: X p m) y, - x * (∑_(i∈ J) f i) == y. - -Definition mx X n m := ord n -> ord m -> X. - -Section bsl. -Context `{X : ops} {u: ob X}. -Notation U := (car (@mor X u u)). - -Lemma toto n m p q (M : mx U n m) N (P : mx U p q) Q i j : ∑_(j0 ∈ seq m) M i j0 * (∑_(j1 ∈ seq p) N j0 j1 * P j1 j) == Q. -Proof. - Fail setoid_rewrite dotxsum. - (* Toplevel input, characters 0-22: -Error: -Tactic failure:setoid rewrite failed: Unable to satisfy the rewriting constraints. -Unable to satisfy the following constraints: -UNDEFINED EVARS: - ?101==[X u n m p q M N P Q i j j0 |- U] (goal evar) - ?106==[X u n m p q M N P Q i j |- relation (X u u)] (internal placeholder) - ?107==[X u n m p q M N P Q i j |- relation (list (ord m))] - (internal placeholder) - ?108==[X u n m p q M N P Q i j (do_subrelation:=do_subrelation) - |- Proper (pointwise_relation (ord m) weq ==> ?107 ==> ?106) sup] - (internal placeholder) - ?109==[X u n m p q M N P Q i j |- ProperProxy ?107 (seq m)] - (internal placeholder) - ?110==[X u n m p q M N P Q i j |- relation (X u u)] (internal placeholder) - ?111==[X u n m p q M N P Q i j (do_subrelation:=do_subrelation) - |- Proper (?106 ==> ?110 ==> Basics.flip Basics.impl) weq] - (internal placeholder) - ?112==[X u n m p q M N P Q i j |- ProperProxy ?110 Q] (internal placeholder)UNIVERSES: - {} |= Top.14 <= Top.37 - Top.25 <= Top.24 - Top.25 <= Top.32 - -ALGEBRAIC UNIVERSES:{} -UNDEFINED UNIVERSES:METAS: - 470[y] := ?101 : car (?99 ?467 ?465) - 469[x] := M i _UNBOUND_REL_1 : car (?99 ?467 ?466) [type is checked] - 468[f] := fun i : ?463 => N _UNBOUND_REL_2 i * P i j : - ?463 -> ?99 ?466 ?465 [type is checked] - 467[p] := u : ob ?99 [type is checked] - 466[m] := u : ob ?99 [type is checked] - 465[n] := u : ob ?99 [type is checked] - 464[J] := seq p : list ?463 [type is checked] - 463[I] := ord p : Type [type is checked] - *) -Abort. - -End bsl. diff --git a/test-suite/bugs/opened/3304.v b/test-suite/bugs/opened/3304.v deleted file mode 100644 index 66668930c7..0000000000 --- a/test-suite/bugs/opened/3304.v +++ /dev/null @@ -1,3 +0,0 @@ -Fail Notation "( x , y , .. , z )" := ltac:(let r := constr:(prod .. (prod x y) .. z) in r). -(* The command has indeed failed with message: -=> Error: Special token .. is for use in the Notation command. *) diff --git a/test-suite/bugs/opened/3311.v b/test-suite/bugs/opened/3311.v deleted file mode 100644 index 1c66bc1e55..0000000000 --- a/test-suite/bugs/opened/3311.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import Setoid. -Axiom bar : True = False. -Goal True. - Fail setoid_rewrite bar. (* Toplevel input, characters 15-33: -Error: -Tactic failure:setoid rewrite failed: Unable to satisfy the rewriting constraints. - -Could not find an instance for "subrelation eq (Basics.flip Basics.impl)". -With the following constraints: -?3 : "True" *) diff --git a/test-suite/bugs/opened/3312.v b/test-suite/bugs/opened/3312.v deleted file mode 100644 index 749921e2f6..0000000000 --- a/test-suite/bugs/opened/3312.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Import Setoid. -Axiom bar : 0 = 1. -Goal 0 = 1. - Fail rewrite_strat bar. (* Toplevel input, characters 15-32: -Error: Tactic failure:setoid rewrite failed: Nothing to rewrite. *) diff --git a/test-suite/bugs/opened/3343.v b/test-suite/bugs/opened/3343.v deleted file mode 100644 index 6c5a85f9cf..0000000000 --- a/test-suite/bugs/opened/3343.v +++ /dev/null @@ -1,46 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 13699 lines to 656 lines, then from 584 lines to 200 lines *) -Set Asymmetric Patterns. -Require Export Coq.Lists.List. -Export List.ListNotations. - -Record CFGV := { Terminal : Type; VarSym : Type }. - -Section Gram. - Context {G : CFGV}. - - Inductive Pattern : (Terminal G) -> Type := - | ptleaf : forall (T : Terminal G), - nat -> Pattern T - with Mixture : list (Terminal G) -> Type := - | mtcons : forall {h: Terminal G} - {tl: list (Terminal G)}, - Pattern h -> Mixture tl -> Mixture (h::tl). - - Variable vc : VarSym G. - - Fixpoint pBVars {gs} (p : Pattern gs) : (list nat) := - match p with - | ptleaf _ _ => [] - end - with mBVars {lgs} (pts : Mixture lgs) : (list nat) := - match pts with - | mtcons _ _ _ tl => mBVars tl - end. - - Lemma mBndngVarsAsNth : - forall mp (m : @Mixture mp), - mBVars m = [2]. - Proof. - intros. - induction m. progress simpl. - Admitted. -End Gram. - -Lemma mBndngVarsAsNth' {G : CFGV} { vc : VarSym G} : - forall mp (m : @Mixture G mp), - mBVars m = [2]. -Proof. - intros. - induction m. - Fail progress simpl. - (* simpl did nothing here, while it does something inside the section; this is probably a bug*) diff --git a/test-suite/bugs/opened/3345.v b/test-suite/bugs/opened/3345.v deleted file mode 100644 index 3e3da6df71..0000000000 --- a/test-suite/bugs/opened/3345.v +++ /dev/null @@ -1,145 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 1972 lines to 136 lines, then from 119 lines to 105 lines *) -Global Set Implicit Arguments. -Require Import Coq.Lists.List Program. -Section IndexBound. - Context {A : Set}. - Class IndexBound (a : A) (Bound : list A) := - { ibound :> nat; - boundi : nth_error Bound ibound = Some a}. - Global Arguments ibound [a Bound] _ . - Global Arguments boundi [a Bound] _. - Record BoundedIndex (Bound : list A) := { bindex :> A; indexb :> IndexBound bindex Bound }. -End IndexBound. -Context {A : Type} {C : Set}. -Variable (projAC : A -> C). -Lemma None_neq_Some -: forall (AnyT AnyT' : Type) (a : AnyT), - None = Some a -> AnyT'. - admit. -Defined. -Program Definition nth_Bounded' - (Bound : list A) - (c : C) - (a_opt : option A) - (nth_n : option_map projAC a_opt = Some c) -: A := match a_opt as x - return (option_map projAC x = Some c) -> A with - | Some a => fun _ => a - | None => fun f : None = Some _ => ! - end nth_n. -Lemma nth_error_map : - forall n As c_opt, - nth_error (map projAC As) n = c_opt - -> option_map projAC (nth_error As n) = c_opt. - admit. -Defined. -Definition nth_Bounded - (Bound : list A) - (idx : BoundedIndex (map projAC Bound)) -: A := nth_Bounded' Bound (nth_error Bound (ibound idx)) - (nth_error_map _ _ (boundi idx)). -Program Definition nth_Bounded_ind2 - (P : forall As, BoundedIndex (map projAC As) - -> BoundedIndex (map projAC As) - -> A -> A -> Prop) -: forall (Bound : list A) - (idx : BoundedIndex (map projAC Bound)) - (idx' : BoundedIndex (map projAC Bound)), - match nth_error Bound (ibound idx), nth_error Bound (ibound idx') with - | Some a, Some a' => P Bound idx idx' a a' - | _, _ => True - end - -> P Bound idx idx' (nth_Bounded _ idx) (nth_Bounded _ idx'):= - fun Bound idx idx' => - match (nth_error Bound (ibound idx)) as e, (nth_error Bound (ibound idx')) as e' - return - (forall (f : option_map _ e = Some (bindex idx)) - (f' : option_map _ e' = Some (bindex idx')), - (match e, e' with - | Some a, Some a' => P Bound idx idx' a a' - | _, _ => True - end) - -> P Bound idx idx' - (match e as e'' return - option_map _ e'' = Some (bindex idx) - -> A - with - | Some a => fun _ => a - | _ => fun f => _ - end f) - (match e' as e'' return - option_map _ e'' = Some (bindex idx') - -> A - with - | Some a => fun _ => a - | _ => fun f => _ - end f')) with - | Some a, Some a' => fun _ _ H => _ - | _, _ => fun f => _ - end (nth_error_map _ _ (boundi idx)) - (nth_error_map _ _ (boundi idx')). - -Lemma nth_Bounded_eq -: forall (Bound : list A) - (idx idx' : BoundedIndex (map projAC Bound)), - ibound idx = ibound idx' - -> nth_Bounded Bound idx = nth_Bounded Bound idx'. -Proof. - intros. - eapply nth_Bounded_ind2 with (idx := idx) (idx' := idx'). - simpl. - (* The [case_eq] should not Fail. More importantly, [Fail case_eq ...] should succeed if [case_eq ...] fails. It doesn't!!! So I resort to [Fail Fail try (case_eq ...)]. *) - Fail Fail try (case_eq (nth_error Bound (ibound idx'))). -(* Toplevel input, characters 15-54: -In nested Ltac calls to "case_eq" and "pattern x at - 1", last call failed. -Error: The abstracted term -"fun e : Exc A => - forall e0 : nth_error Bound (ibound idx') = e, - match - nth_error Bound (ibound idx) as anonymous'0 - return (anonymous'0 = nth_error Bound (ibound idx) -> e = e -> Prop) - with - | Some a => - match - e as anonymous' - return - (Some a = nth_error Bound (ibound idx) -> anonymous' = e -> Prop) - with - | Some a' => - fun (_ : Some a = nth_error Bound (ibound idx)) (_ : Some a' = e) => - a = a' - | None => - fun (_ : Some a = nth_error Bound (ibound idx)) (_ : None = e) => - True - end - | None => fun (_ : None = nth_error Bound (ibound idx)) (_ : e = e) => True - end eq_refl e0" is not well typed. -Illegal application: -The term - "match - nth_error Bound (ibound idx) as anonymous'0 - return (anonymous'0 = nth_error Bound (ibound idx) -> e = e -> Prop) - with - | Some a => - match - e as anonymous' - return - (Some a = nth_error Bound (ibound idx) -> anonymous' = e -> Prop) - with - | Some a' => - fun (_ : Some a = nth_error Bound (ibound idx)) (_ : Some a' = e) => - a = a' - | None => - fun (_ : Some a = nth_error Bound (ibound idx)) (_ : None = e) => - True - end - | None => fun (_ : None = nth_error Bound (ibound idx)) (_ : e = e) => True - end" of type - "nth_error Bound (ibound idx) = nth_error Bound (ibound idx) -> - e = e -> Prop" -cannot be applied to the terms - "eq_refl" : "nth_error Bound (ibound idx) = nth_error Bound (ibound idx)" - "e0" : "nth_error Bound (ibound idx') = e" -The 2nd term has type "nth_error Bound (ibound idx') = e" -which should be coercible to "e = e". *) diff --git a/test-suite/bugs/opened/3357.v b/test-suite/bugs/opened/3357.v deleted file mode 100644 index c479158877..0000000000 --- a/test-suite/bugs/opened/3357.v +++ /dev/null @@ -1,9 +0,0 @@ -Notation D1 := (forall {T : Type} ( x : T ) , Type). - -Definition DD1 ( A : forall {T : Type} (x : T), Type ) := A 1. -Fail Definition DD1' ( A : D1 ) := A 1. (* Toplevel input, characters 32-33: -Error: In environment -A : forall T : Type, T -> Type -The term "1" has type "nat" while it is expected to have type -"Type". - *) diff --git a/test-suite/bugs/opened/3363.v b/test-suite/bugs/opened/3363.v deleted file mode 100644 index 800d89573c..0000000000 --- a/test-suite/bugs/opened/3363.v +++ /dev/null @@ -1,26 +0,0 @@ -(** In this file, either all four [Check]s should fail, or all four should succeed. *) -Module A. - Section HexStrings. - Require Import String. - End HexStrings. - Fail Check string. -End A. - -Module B. - Section HexStrings. - Require String. - Import String. - End HexStrings. - Fail Check string. -End B. - -Section HexStrings. - Require String. - Import String. -End HexStrings. -Fail Check string. - -Section HexStrings'. - Require Import String. -End HexStrings'. -Check string. diff --git a/test-suite/bugs/opened/3370.v b/test-suite/bugs/opened/3370.v deleted file mode 100644 index 4964bf96c0..0000000000 --- a/test-suite/bugs/opened/3370.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import String. - -Local Ltac set_strings := - let s := match goal with |- context[String ?s1 ?s2] => constr:(String s1 s2) end in - let H := fresh s in - set (H := s). - -Local Open Scope string_scope. - -Goal "asdf" = "bds". -Fail set_strings. (* Error: Ltac variable s is bound to "asdf" which cannot be coerced to -a fresh identifier. *) diff --git a/test-suite/bugs/opened/3395.v b/test-suite/bugs/opened/3395.v deleted file mode 100644 index 5ca48fc9d6..0000000000 --- a/test-suite/bugs/opened/3395.v +++ /dev/null @@ -1,231 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from originally 10918 lines, then 3649 lines to 3177 lines, then from 3189 lines to 3164 lines, then from 2653 lines to 2496 lines, 2653 lines, then from 1642 lines to 651 lines, then from 736 lines to 473 lines, then from 433 lines to 275 lines, then from 258 lines to 235 lines. *) -Generalizable All Variables. -Set Implicit Arguments. - -Arguments fst {_ _} _. -Arguments snd {_ _} _. - -Axiom cheat : forall {T}, T. - -Reserved Notation "g 'o' f" (at level 40, left associativity). - -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y" := (paths x y) : type_scope. - -Definition symmetry {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. -Record PreCategory (object : Type) := - Build_PreCategory' { - object :> Type := object; - morphism : object -> object -> Type; - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g); - associativity : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - (m3 o m2) o m1 = m3 o (m2 o m1); - associativity_sym : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - m3 o (m2 o m1) = (m3 o m2) o m1; - left_identity : forall a b (f : morphism a b), identity b o f = f; - right_identity : forall a b (f : morphism a b), f o identity a = f; - identity_identity : forall x, identity x o identity x = identity x - }. -Bind Scope category_scope with PreCategory. -Arguments PreCategory {_}. -Arguments identity {_} [!C%category] x%object : rename. - -Arguments compose {_} [!C%category s%object d%object d'%object] m1%morphism m2%morphism : rename. - -Infix "o" := compose : morphism_scope. - -Delimit Scope functor_scope with functor. -Local Open Scope morphism_scope. -Record Functor `(C : @PreCategory objC, D : @PreCategory objD) := - { - object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d); - composition_of : forall s d d' - (m1 : morphism C s d) (m2: morphism C d d'), - morphism_of _ _ (m2 o m1) - = (morphism_of _ _ m2) o (morphism_of _ _ m1); - identity_of : forall x, morphism_of _ _ (identity x) - = identity (object_of x) - }. -Bind Scope functor_scope with Functor. - -Arguments morphism_of {_} [C%category] {_} [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. - -Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. - -Class IsIsomorphism `{C : @PreCategory objC} {s d} (m : morphism C s d) := - { - morphism_inverse : morphism C d s; - left_inverse : morphism_inverse o m = identity _; - right_inverse : m o morphism_inverse = identity _ - }. - -Definition opposite `(C : @PreCategory objC) : PreCategory - := @Build_PreCategory' - C - (fun s d => morphism C d s) - (identity (C := C)) - (fun _ _ _ m1 m2 => m2 o m1) - (fun _ _ _ _ _ _ _ => @associativity_sym _ _ _ _ _ _ _ _ _) - (fun _ _ _ _ _ _ _ => @associativity _ _ _ _ _ _ _ _ _) - (fun _ _ => @right_identity _ _ _ _) - (fun _ _ => @left_identity _ _ _ _) - (@identity_identity _ C). - -Notation "C ^op" := (opposite C) (at level 3) : category_scope. - -Definition prod `(C : @PreCategory objC, D : @PreCategory objD) : @PreCategory (objC * objD). - refine (@Build_PreCategory' - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) - * morphism D (snd s) (snd d))%type) - (fun x => (identity (fst x), identity (snd x))) - (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1)) - _ - _ - _ - _ - _); admit. -Defined. -Infix "*" := prod : category_scope. - -Definition compose_functor `(C : @PreCategory objC, D : @PreCategory objD, E : @PreCategory objE) (G : Functor D E) (F : Functor C D) : Functor C E - := Build_Functor - C E - (fun c => G (F c)) - (fun _ _ m => morphism_of G (morphism_of F m)) - cheat - cheat. - -Infix "o" := compose_functor : functor_scope. - -Record NaturalTransformation `(C : @PreCategory objC, D : @PreCategory objD) (F G : Functor C D) := - Build_NaturalTransformation' { - components_of :> forall c, morphism D (F c) (G c); - commutes : forall s d (m : morphism C s d), - components_of d o F _1 m = G _1 m o components_of s; - - commutes_sym : forall s d (m : C.(morphism) s d), - G _1 m o components_of s = components_of d o F _1 m - }. -Definition functor_category `(C : @PreCategory objC, D : @PreCategory objD) : PreCategory - := @Build_PreCategory' (Functor C D) - (@NaturalTransformation _ C _ D) - cheat - cheat - cheat - cheat - cheat - cheat - cheat. - -Definition opposite_functor `(F : @Functor objC C objD D) : Functor C^op D^op - := Build_Functor (C^op) (D^op) - (object_of F) - (fun s d => morphism_of F (s := d) (d := s)) - (fun d' d s m1 m2 => composition_of F s d d' m2 m1) - (identity_of F). - -Definition opposite_invL `(F : @Functor objC C^op objD D) : Functor C D^op - := Build_Functor C (D^op) - (object_of F) - (fun s d => morphism_of F (s := d) (d := s)) - (fun d' d s m1 m2 => composition_of F s d d' m2 m1) - (identity_of F). -Notation "F ^op" := (opposite_functor F) : functor_scope. - -Notation "F ^op'L" := (opposite_invL F) (at level 3) : functor_scope. -Definition fst `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) C - := Build_Functor (C * D) C - (@fst _ _) - (fun _ _ => @fst _ _) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). - -Definition snd `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) D - := Build_Functor (C * D) D - (@snd _ _) - (fun _ _ => @snd _ _) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). -Definition prod_functor `(F : @Functor objC C objD D, F' : @Functor objC C objD' D') -: Functor C (D * D') - := Build_Functor - C (D * D') - (fun c => (F c, F' c)) - (fun s d m => (F _1 m, F' _1 m))%morphism - cheat - cheat. -Definition pair `(F : @Functor objC C objD D, F' : @Functor objC' C' objD' D') : Functor (C * C') (D * D') - := (prod_functor (F o fst) (F' o snd))%functor. -Notation cat_of obj := - (@Build_PreCategory' obj - (fun x y => forall _ : x, y) - (fun _ x => x) - (fun _ _ _ f g x => f (g x))%core - (fun _ _ _ _ _ _ _ => idpath) - (fun _ _ _ _ _ _ _ => idpath) - (fun _ _ _ => idpath) - (fun _ _ _ => idpath) - (fun _ => idpath)). - -Definition hom_functor `(C : @PreCategory objC) : Functor (C^op * C) (cat_of Type) - := Build_Functor _ _ cheat cheat cheat cheat. - -Definition induced_hom_natural_transformation `(F : @Functor objC C objD D) -: NaturalTransformation (hom_functor C) (hom_functor D o pair F^op F) - := Build_NaturalTransformation' _ _ cheat cheat cheat. - -Class IsFullyFaithful `(F : @Functor objC C objD D) - := is_fully_faithful - : forall x y : C, - IsIsomorphism (induced_hom_natural_transformation F (x, y)). - -Definition coyoneda `(A : @PreCategory objA) : Functor A^op (@functor_category _ A _ (cat_of Type)) - := cheat. - -Definition yoneda `(A : @PreCategory objA) : Functor A (@functor_category _ A^op _ (cat_of Type)) - := (((coyoneda A^op)^op'L)^op'L)%functor. -Definition coyoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@coyoneda _ A). -Admitted. - -Definition yoneda_embedding_fast `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A). -Proof. - intros a b. - pose proof (coyoneda_embedding A^op a b) as CYE. - unfold yoneda. - Time let t := (type of CYE) in - let t' := (eval simpl in t) in pose proof ((fun (x : t) => (x : t')) CYE) as CYE'. (* Finished transaction in 0. secs (0.216013u,0.004s) *) - Fail Timeout 1 let t := match goal with |- ?G => constr:(G) end in - let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE'). - Time let t := match goal with |- ?G => constr:(G) end in - let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE'). (* Finished transaction in 0. secs (0.248016u,0.s) *) -Fail Timeout 2 Defined. -Time Defined. (* Finished transaction in 1. secs (0.432027u,0.s) *) - -Definition yoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A). -Proof. - intros a b. - pose proof (coyoneda_embedding A^op a b) as CYE. - unfold yoneda; simpl in *. - Fail Timeout 1 exact CYE. - Time exact CYE. (* Finished transaction in 0. secs (0.012001u,0.s) *) diff --git a/test-suite/bugs/opened/3424.v b/test-suite/bugs/opened/3424.v deleted file mode 100644 index d1c5bb68f9..0000000000 --- a/test-suite/bugs/opened/3424.v +++ /dev/null @@ -1,24 +0,0 @@ -Set Universe Polymorphism. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Class Contr_internal (A : Type) := BuildContr { center : A ; contr : (forall y : A, center = y) }. -Inductive trunc_index : Type := minus_two | trunc_S (x : trunc_index). -Bind Scope trunc_scope with trunc_index. -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. -Notation minus_one:=(trunc_S minus_two). -Notation "0" := (trunc_S minus_one) : trunc_scope. -Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. -Notation IsHProp := (IsTrunc minus_one). -Notation IsHSet := (IsTrunc 0). -Goal forall (A : Type) (a b : A) (H' : IsHSet A), { x : Type & IsHProp x }. -Proof. -intros. -eexists. -(* exact (H' a b). *) -(* Undo. *) -Fail apply (H' a b). -exact (H' a b). -Qed. diff --git a/test-suite/bugs/opened/3459.v b/test-suite/bugs/opened/3459.v deleted file mode 100644 index 762611f751..0000000000 --- a/test-suite/bugs/opened/3459.v +++ /dev/null @@ -1,31 +0,0 @@ -(* Bad interaction between clear and the typability of ltac constr bindings *) - -(* Original report *) - -Goal 1 = 2. -Proof. -(* This line used to fail with a Not_found up to some point, and then - to produce an ill-typed term *) -match goal with - | [ |- context G[2] ] => let y := constr:(fun x => ltac:(let r := constr:(@eq Set x x) in - clear x; - exact r)) in - pose y -end. -(* Add extra test for typability (should not fail when bug closed) *) -Fail match goal with P:?c |- _ => try (let x := type of c in idtac) || fail 2 end. -Abort. - -(* Second report raising a Not_found at the time of 21 Oct 2014 *) - -Section F. - -Variable x : nat. - -Goal True. -evar (e : Prop). -assert e. -Fail let r := constr:(eq_refl x) in clear x; exact r. -Abort. - -End F. diff --git a/test-suite/bugs/opened/3463.v b/test-suite/bugs/opened/3463.v deleted file mode 100644 index 541db37fb7..0000000000 --- a/test-suite/bugs/opened/3463.v +++ /dev/null @@ -1,13 +0,0 @@ -Tactic Notation "test1" open_constr(t) ident(r):= - pose t. -Tactic Notation "test2" constr(r) open_constr(t):= - pose t. -Tactic Notation "test3" open_constr(t) constr(r):= - pose t. - -Goal True. - test1 (1 + _) nat. - test2 nat (1 + _). - test3 (1 + _) nat. - test3 (1 + _ : nat) nat. - diff --git a/test-suite/bugs/opened/3478.v-disabled b/test-suite/bugs/opened/3478.v-disabled deleted file mode 100644 index cc926b2167..0000000000 --- a/test-suite/bugs/opened/3478.v-disabled +++ /dev/null @@ -1,8 +0,0 @@ -Set Primitive Projections. -Record foo := { foom :> Type }. -Canonical Structure default_foo := fun T => {| foom := T |}. -Record bar T := { bar1 : T }. -Goal forall (s : foo) (x : foom s), True. -Proof. - intros. - Timeout 1 pose (x : bar _) as x'. \ No newline at end of file diff --git a/test-suite/bugs/opened/3626.v b/test-suite/bugs/opened/3626.v deleted file mode 100644 index 46a6c009eb..0000000000 --- a/test-suite/bugs/opened/3626.v +++ /dev/null @@ -1,7 +0,0 @@ -Set Implicit Arguments. -Set Primitive Projections. -Record prod A B := pair { fst : A ; snd : B }. - -Fail Goal forall x y : prod Set Set, x.(@fst) = y.(@fst). -(* intros. - apply f_equal. *) diff --git a/test-suite/bugs/opened/3655.v b/test-suite/bugs/opened/3655.v deleted file mode 100644 index 841f77febb..0000000000 --- a/test-suite/bugs/opened/3655.v +++ /dev/null @@ -1,9 +0,0 @@ -Ltac bar x := pose x. -Tactic Notation "foo" open_constr(x) := bar x. -Class baz := { baz' : Type }. -Goal True. -(* Original error was an anomaly which is fixed; now, it succeeds but - leaving an evar, while calling pose would not leave an evar, so I - guess it is still a bug in the sense that the semantics of pose is - not preserved *) - foo baz'. diff --git a/test-suite/bugs/opened/3754.v b/test-suite/bugs/opened/3754.v deleted file mode 100644 index a717bbe735..0000000000 --- a/test-suite/bugs/opened/3754.v +++ /dev/null @@ -1,284 +0,0 @@ -Unset Strict Universe Declaration. -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 9113 lines to 279 lines *) -(* coqc version trunk (October 2014) compiled on Oct 19 2014 18:56:9 with OCaml 3.12.1 - coqtop version trunk (October 2014) *) - -Notation Type0 := Set. - -Notation idmap := (fun x => x). - -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. - -Notation pr1 := projT1. - -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. - -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := - fun x => g (f x). - -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. -Open Scope function_scope. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x. -admit. -Defined. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Notation "1" := idpath : path_scope. - -Notation "p @ q" := (concat p q) (at level 20) : path_scope. - -Notation "p ^" := (inverse p) (at level 3, format "p '^'") : path_scope. - -Notation "p @' q" := (concat p q) (at level 21, left associativity, - format "'[v' p '/' '@'' q ']'") : long_path_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y. -exact (match p with idpath => u end). -Defined. - -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y. -exact (match p with idpath => idpath end). -Defined. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) -}. - -Arguments eisretr {A B} f {_} _. - -Record Equiv A B := BuildEquiv { - equiv_fun : A -> B ; - equiv_isequiv : IsEquiv equiv_fun -}. - -Coercion equiv_fun : Equiv >-> Funclass. - -Global Existing Instance equiv_isequiv. - -Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) -}. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. -Local Open Scope trunc_scope. -Notation "-2" := minus_two (at level 0) : trunc_scope. -Notation "-1" := (-2.+1) (at level 0) : trunc_scope. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | -2 => Contr_internal A - | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. -Notation IsHProp := (IsTrunc -1). - -Monomorphic Axiom dummy_funext_type : Type0. -Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. - -Local Open Scope path_scope. - -Definition concat_p1 {A : Type} {x y : A} (p : x = y) : - p @ 1 = p - := - match p with idpath => 1 end. - -Definition concat_1p {A : Type} {x y : A} (p : x = y) : - 1 @ p = p - := - match p with idpath => 1 end. - -Definition concat_p_pp {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z = t) : - p @ (q @ r) = (p @ q) @ r := - match r with idpath => - match q with idpath => - match p with idpath => 1 - end end end. - -Definition concat_pp_p {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z = t) : - (p @ q) @ r = p @ (q @ r) := - match r with idpath => - match q with idpath => - match p with idpath => 1 - end end end. - -Definition moveL_Mp {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x) : - r^ @ q = p -> q = r @ p. -admit. -Defined. - -Ltac with_rassoc tac := - repeat rewrite concat_pp_p; - tac; - - repeat rewrite concat_p_pp. - -Ltac rewrite_moveL_Mp_p := with_rassoc ltac:(apply moveL_Mp). - -Definition ap_p_pp {A B : Type} (f : A -> B) {w : B} {x y z : A} - (r : w = f x) (p : x = y) (q : y = z) : - r @ (ap f (p @ q)) = (r @ ap f p) @ (ap f q). -admit. -Defined. - -Definition ap_compose {A B C : Type} (f : A -> B) (g : B -> C) {x y : A} (p : x = y) : - ap (g o f) p = ap g (ap f p) - := - match p with idpath => 1 end. - -Definition concat_Ap {A B : Type} {f g : A -> B} (p : forall x, f x = g x) {x y : A} (q : x = y) : - (ap f q) @ (p y) = (p x) @ (ap g q) - := - match q with - | idpath => concat_1p _ @ ((concat_p1 _) ^) - end. - -Definition transportD2 {A : Type} (B C : A -> Type) (D : forall a:A, B a -> C a -> Type) - {x1 x2 : A} (p : x1 = x2) (y : B x1) (z : C x1) (w : D x1 y z) - : D x2 (p # y) (p # z) - := - match p with idpath => w end. -Local Open Scope equiv_scope. - -Definition transport_arrow_toconst {A : Type} {B : A -> Type} {C : Type} - {x1 x2 : A} (p : x1 = x2) (f : B x1 -> C) (y : B x2) - : (transport (fun x => B x -> C) p f) y = f (p^ # y). -admit. -Defined. - -Definition transport_arrow_fromconst {A B : Type} {C : A -> Type} - {x1 x2 : A} (p : x1 = x2) (f : B -> C x1) (y : B) - : (transport (fun x => B -> C x) p f) y = p # (f y). -admit. -Defined. - -Definition ap_transport_arrow_toconst {A : Type} {B : A -> Type} {C : Type} - {x1 x2 : A} (p : x1 = x2) (f : B x1 -> C) {y1 y2 : B x2} (q : y1 = y2) - : ap (transport (fun x => B x -> C) p f) q - @ transport_arrow_toconst p f y2 - = transport_arrow_toconst p f y1 - @ ap (fun y => f (p^ # y)) q. -admit. -Defined. - -Class Univalence. -Definition path_universe {A B : Type} (f : A -> B) {feq : IsEquiv f} : (A = B). -admit. -Defined. -Definition transport_path_universe - {A B : Type} (f : A -> B) {feq : IsEquiv f} (z : A) - : transport (fun X:Type => X) (path_universe f) z = f z. -admit. -Defined. -Definition transport_path_universe_V `{Funext} - {A B : Type} (f : A -> B) {feq : IsEquiv f} (z : B) - : transport (fun X:Type => X) (path_universe f)^ z = f^-1 z. -admit. -Defined. - -Ltac simpl_do_clear tac term := - let H := fresh in - assert (H := term); - simpl in H |- *; - tac H; - clear H. - -Tactic Notation "simpl" "rewrite" constr(term) := simpl_do_clear ltac:(fun H => rewrite H) term. - -Global Instance Univalence_implies_Funext `{Univalence} : Funext. -Admitted. - -Section Factorization. - - Context {class1 class2 : forall (X Y : Type@{i}), (X -> Y) -> Type@{i}} - `{forall (X Y : Type@{i}) (g:X->Y), IsHProp (class1 _ _ g)} - `{forall (X Y : Type@{i}) (g:X->Y), IsHProp (class2 _ _ g)} - {A B : Type@{i}} {f : A -> B}. - - Record Factorization := - { intermediate : Type ; - factor1 : A -> intermediate ; - factor2 : intermediate -> B ; - fact_factors : factor2 o factor1 == f ; - inclass1 : class1 _ _ factor1 ; - inclass2 : class2 _ _ factor2 - }. - - Record PathFactorization {fact fact' : Factorization} := - { path_intermediate : intermediate fact <~> intermediate fact' ; - path_factor1 : path_intermediate o factor1 fact == factor1 fact' ; - path_factor2 : factor2 fact == factor2 fact' o path_intermediate ; - path_fact_factors : forall a, path_factor2 (factor1 fact a) - @ ap (factor2 fact') (path_factor1 a) - @ fact_factors fact' a - = fact_factors fact a - }. - Context `{Univalence} {fact fact' : Factorization} - (pf : @PathFactorization fact fact'). - - Let II := path_intermediate pf. - Let ff1 := path_factor1 pf. - Let ff2 := path_factor2 pf. -Local Definition II' : intermediate fact = intermediate fact'. -admit. -Defined. - - Local Definition fff' (a : A) - : (transportD2 (fun X => A -> X) (fun X => X -> B) - (fun X g h => {_ : forall a : A, h (g a) = f a & - {_ : class1 A X g & class2 X B h}}) - II' (factor1 fact) (factor2 fact) - (fact_factors fact; (inclass1 fact; inclass2 fact))).1 a = - ap (transport (fun X => X -> B) II' (factor2 fact)) - (transport_arrow_fromconst II' (factor1 fact) a - @ transport_path_universe II (factor1 fact a) - @ ff1 a) - @ transport_arrow_toconst II' (factor2 fact) (factor1 fact' a) - @ ap (factor2 fact) (transport_path_universe_V II (factor1 fact' a)) - @ ff2 (II^-1 (factor1 fact' a)) - @ ap (factor2 fact') (eisretr II (factor1 fact' a)) - @ fact_factors fact' a. - Proof. - - Open Scope long_path_scope. - - rewrite (ap_transport_arrow_toconst (B := idmap) (C := B)). - - simpl rewrite (@ap_compose _ _ _ (transport idmap (path_universe II)^) - (factor2 fact)). - rewrite <- ap_p_pp; rewrite_moveL_Mp_p. - Set Debug Tactic Unification. - Fail rewrite (concat_Ap ff2). diff --git a/test-suite/bugs/opened/3794.v b/test-suite/bugs/opened/3794.v deleted file mode 100644 index e4711a38c0..0000000000 --- a/test-suite/bugs/opened/3794.v +++ /dev/null @@ -1,7 +0,0 @@ -Hint Extern 10 ((?X = ?Y) -> False) => intros; discriminate. -Hint Unfold not : core. - -Goal true<>false. -Set Typeclasses Debug. -Fail typeclasses eauto with core. -Abort. diff --git a/test-suite/bugs/opened/3889.v b/test-suite/bugs/opened/3889.v deleted file mode 100644 index 6b287324cc..0000000000 --- a/test-suite/bugs/opened/3889.v +++ /dev/null @@ -1,11 +0,0 @@ -Require Import Program. - -Inductive Even : nat -> Prop := -| evenO : Even O -| evenS : forall n, Odd n -> Even (S n) -with Odd : nat -> Prop := -| oddS : forall n, Even n -> Odd (S n). -Axiom admit : forall {T}, T. -Program Fixpoint doubleE {n} (e : Even n) : Even (2 * n) := admit -with doubleO {n} (o : Odd n) : Odd (S (2 * n)) := _. -Next Obligation of doubleE. diff --git a/test-suite/bugs/opened/3890.v b/test-suite/bugs/opened/3890.v deleted file mode 100644 index f9ac9be2c8..0000000000 --- a/test-suite/bugs/opened/3890.v +++ /dev/null @@ -1,18 +0,0 @@ -Class Foo. -Class Bar := b : Type. - -Instance foo : Foo := _. -(* 1 subgoals, subgoal 1 (ID 4) - - ============================ - Foo *) - -Instance bar : Bar. -exact Type. -Defined. -(* bar is defined *) - -About foo. -(* foo not a defined object. *) - -Fail Defined. diff --git a/test-suite/bugs/opened/3919.v-disabled b/test-suite/bugs/opened/3919.v-disabled deleted file mode 100644 index 0d661de9c4..0000000000 --- a/test-suite/bugs/opened/3919.v-disabled +++ /dev/null @@ -1,13 +0,0 @@ -Require Import MSets. -Require Import Orders. - -Declare Module Signal : OrderedType. - -Module S := MSetAVL.Make(Signal). -Module Sdec := Decide(S). -Export Sdec. - -Hint Extern 0 (Signal.eq ?x ?y) => now symmetry. - -Goal forall o s, Signal.eq o s. -Proof. fsetdec. Qed. diff --git a/test-suite/bugs/opened/3922.v-disabled b/test-suite/bugs/opened/3922.v-disabled deleted file mode 100644 index ce4f509cad..0000000000 --- a/test-suite/bugs/opened/3922.v-disabled +++ /dev/null @@ -1,83 +0,0 @@ -Set Universe Polymorphism. -Notation Type0 := Set. - -Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. -Open Scope function_scope. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) -}. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. -Local Open Scope trunc_scope. -Notation "-2" := minus_two (at level 0) : trunc_scope. -Notation "-1" := (-2.+1) (at level 0) : trunc_scope. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | -2 => Contr_internal A - | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Notation Contr := (IsTrunc -2). -Notation IsHProp := (IsTrunc -1). - -Monomorphic Axiom dummy_funext_type : Type0. -Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. - -Inductive Unit : Type1 := - tt : Unit. - -Record TruncType (n : trunc_index) := BuildTruncType { - trunctype_type : Type ; - istrunc_trunctype_type : IsTrunc n trunctype_type -}. - -Arguments BuildTruncType _ _ {_}. - -Coercion trunctype_type : TruncType >-> Sortclass. - -Notation "n -Type" := (TruncType n) (at level 1) : type_scope. -Notation hProp := (-1)-Type. - -Notation BuildhProp := (BuildTruncType -1). - -Private Inductive Trunc (n : trunc_index) (A :Type) : Type := - tr : A -> Trunc n A. -Arguments tr {n A} a. - -Global Instance istrunc_truncation (n : trunc_index) (A : Type@{i}) -: IsTrunc@{j} n (Trunc@{i} n A). -Admitted. - -Definition Trunc_ind {n A} - (P : Trunc n A -> Type) {Pt : forall aa, IsTrunc n (P aa)} - : (forall a, P (tr a)) -> (forall aa, P aa) -:= (fun f aa => match aa with tr a => fun _ => f a end Pt). -Definition merely (A : Type@{i}) : hProp@{i} := BuildhProp (Trunc -1 A). -Definition cconst_factors_contr `{Funext} {X Y : Type} (f : X -> Y) - (P : Type) `{Pc : X -> Contr P} - (g : X -> P) (h : P -> Y) (p : h o g == f) -: Unit. -Proof. - assert (merely X -> IsHProp P) by admit. - refine (let g' := Trunc_ind (fun _ => P) g : merely X -> P in _); - [ assumption.. | ]. - Fail pose (g' := Trunc_ind (fun _ => P) g : merely X -> P). diff --git a/test-suite/bugs/opened/3928.v-disabled b/test-suite/bugs/opened/3928.v-disabled deleted file mode 100644 index b470eb229b..0000000000 --- a/test-suite/bugs/opened/3928.v-disabled +++ /dev/null @@ -1,12 +0,0 @@ -Typeclasses eauto := bfs. - -Class Foo := {}. -Class Bar := {}. - -Instance: Bar. -Instance: Foo -> Bar -> Foo -> Foo | 1. -Instance: Bar -> Foo | 100. -Instance: Foo -> Bar -> Foo -> Foo | 1. - -Set Typeclasses Debug. -Timeout 1 Check (_ : Foo). (* timeout *) diff --git a/test-suite/bugs/opened/3938.v b/test-suite/bugs/opened/3938.v deleted file mode 100644 index 2d0d1930f1..0000000000 --- a/test-suite/bugs/opened/3938.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import Coq.Arith.PeanoNat. -Hint Extern 1 => admit : typeclass_instances. -Goal forall a b (f : nat -> Set), Nat.eq a b -> f a = f b. - intros a b f H. - rewrite H. (* Toplevel input, characters 15-25: -Anomaly: Evar ?X11 was not declared. Please report. *) diff --git a/test-suite/bugs/opened/3946.v b/test-suite/bugs/opened/3946.v deleted file mode 100644 index e77bdbc652..0000000000 --- a/test-suite/bugs/opened/3946.v +++ /dev/null @@ -1,11 +0,0 @@ -Require Import ZArith. - -Inductive foo := Foo : Z.le 0 1 -> foo. - -Definition bar (f : foo) := let (f) := f in f. - -(* Doesn't work: *) -(* Arguments bar f.*) - -(* Does work *) -Arguments bar f _. diff --git a/test-suite/bugs/opened/4701.v b/test-suite/bugs/opened/4701.v deleted file mode 100644 index 9286f0f1f0..0000000000 --- a/test-suite/bugs/opened/4701.v +++ /dev/null @@ -1,23 +0,0 @@ -(*Suppose we have*) - - Inductive my_if {A B} : bool -> Type := - | then_case (_ : A) : my_if true - | else_case (_ : B) : my_if false. - Notation "'If' b 'Then' A 'Else' B" := (@my_if A B b) (at level 10). - -(*then here are three inductive type declarations that work:*) - - Inductive I1 := - | i1 (x : I1). - Inductive I2 := - | i2 (x : nat). - Inductive I3 := - | i3 (b : bool) (x : If b Then I3 Else nat). - -(*and here is one that does not, despite being equivalent to [I3]:*) - - Fail Inductive I4 := - | i4 (b : bool) (x : if b then I4 else nat). (* Error: Non strictly positive occurrence of "I4" in - "forall b : bool, (if b then I4 else nat) -> I4". *) - -(*I think this one should work. I believe this is a conservative extension over CIC: Since [match] statements returning types can always be re-encoded as inductive type families, the analysis should be independent of whether the constructor uses an inductive or a [match] statement.*) diff --git a/test-suite/bugs/opened/4721.v b/test-suite/bugs/opened/4721.v deleted file mode 100644 index 1f184b3930..0000000000 --- a/test-suite/bugs/opened/4721.v +++ /dev/null @@ -1,13 +0,0 @@ -Variables S1 S2 : Set. - -Goal @eq Type S1 S2 -> @eq Type S1 S2. -intro H. -Fail tauto. -assumption. -Qed. - -(*This is in 8.5pl1, and Matthieq Sozeau says: "That's a regression in tauto indeed, which now requires exact equality of the universes, through a non linear goal pattern matching: -match goal with ?X1 |- ?X1 forces both instances of X1 to be convertible, -with no additional universe constraints currently, but the two types are -initially different. This can be fixed easily to allow the same flexibility -as in 8.4 (or assumption) to unify the universes as well."*) diff --git a/test-suite/bugs/opened/4728.v b/test-suite/bugs/opened/4728.v deleted file mode 100644 index 230b4beb6c..0000000000 --- a/test-suite/bugs/opened/4728.v +++ /dev/null @@ -1,72 +0,0 @@ -(*I'd like the final [Check] in the following to work:*) - -Ltac fin_eta_expand := - [ > lazymatch goal with - | [ H : _ |- _ ] => clear H - end.. - | lazymatch goal with - | [ H : ?T |- ?T ] - => exact H - | [ |- ?G ] - => fail 0 "No hypothesis matching" G - end ]; - let n := numgoals in - tryif constr_eq numgoals 0 - then idtac - else fin_eta_expand. - -Ltac pre_eta_expand x := - let T := type of x in - let G := match goal with |- ?G => G end in - unify T G; - unshelve econstructor; - destruct x; - fin_eta_expand. - -Ltac eta_expand x := - let v := constr:(ltac:(pre_eta_expand x)) in - idtac v; - let v := (eval cbv beta iota zeta in v) in - exact v. - -Notation eta_expand x := (ltac:(eta_expand x)) (only parsing). - -Ltac partial_unify eqn := - lazymatch eqn with - | ?x = ?x => idtac - | ?f ?x = ?g ?y - => partial_unify (f = g); - (tryif unify x y then - idtac - else tryif has_evar x then - unify x y - else tryif has_evar y then - unify x y - else - idtac) - | ?x = ?y - => idtac; - (tryif unify x y then - idtac - else tryif has_evar x then - unify x y - else tryif has_evar y then - unify x y - else - idtac) - end. - -Tactic Notation "{" open_constr(old_record) "with" open_constr(new_record) "}" := - let old_record' := eta_expand old_record in - partial_unify (old_record = new_record); - eexact new_record. - -Set Implicit Arguments. -Record prod A B := pair { fst : A ; snd : B }. -Infix "*" := prod : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. - -Notation "{ old 'with' new }" := (ltac:({ old with new })) (only parsing). - -Check ltac:({ (1, 1) with {| snd := 2 |} }). -Fail Check { (1, 1) with {| snd := 2 |} }. (* Error: Cannot infer this placeholder of type "Type"; should succeed *) diff --git a/test-suite/bugs/opened/4755.v b/test-suite/bugs/opened/4755.v deleted file mode 100644 index 9cc0d361ea..0000000000 --- a/test-suite/bugs/opened/4755.v +++ /dev/null @@ -1,34 +0,0 @@ -(*I'm not sure which behavior is better. But if the change is intentional, it should be documented (I don't think it is), and it'd be nice if there were a flag for this, or if -compat 8.4 restored the old behavior.*) - -Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. -Definition f (v : option nat) := match v with - | Some k => Some k - | None => None - end. - -Axioms F G : (option nat -> option nat) -> Prop. -Axiom FG : forall f, f None = None -> F f = G f. - -Axiom admit : forall {T}, T. - -Existing Instance eq_Reflexive. - -Global Instance foo (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. - -Global Instance bar (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> eq ==> Basics.flip Basics.impl) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. - -Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. -Proof. - intro. - pose proof (_ : (Proper (_ ==> eq ==> _) and)). - Fail setoid_rewrite (FG _ _); []. (* In 8.5: Error: Tactic failure: Incorrect number of goals (expected 2 tactics); works in 8.4 *) diff --git a/test-suite/bugs/opened/4771.v b/test-suite/bugs/opened/4771.v deleted file mode 100644 index 396d74bdbf..0000000000 --- a/test-suite/bugs/opened/4771.v +++ /dev/null @@ -1,22 +0,0 @@ -Module Type Foo. - -Parameter Inline t : nat. - -End Foo. - -Module F(X : Foo). - -Tactic Notation "foo" ref(x) := idtac. - -Ltac g := foo X.t. - -End F. - -Module N. -Definition t := 0 + 0. -End N. - -Module K := F(N). - -(* Was -Anomaly: Uncaught exception Not_found. Please report. *) diff --git a/test-suite/bugs/opened/4778.v b/test-suite/bugs/opened/4778.v deleted file mode 100644 index 633d158e96..0000000000 --- a/test-suite/bugs/opened/4778.v +++ /dev/null @@ -1,35 +0,0 @@ -Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. -Definition f (v : option nat) := match v with - | Some k => Some k - | None => None - end. - -Axioms F G : (option nat -> option nat) -> Prop. -Axiom FG : forall f, f None = None -> F f = G f. - -Axiom admit : forall {T}, T. - -Existing Instance eq_Reflexive. - -(* This instance is needed in 8.4, but is useless in 8.5 *) -Global Instance foo (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. - -(* -(* This is required in 8.5, but useless in 8.4 *) -Global Instance bar (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> eq ==> Basics.flip Basics.impl) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. -*) - -Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. Proof. - intro. - pose proof (_ : (Proper (_ ==> eq ==> _) and)). - Fail setoid_rewrite (FG _ _); [ | reflexivity.. ]. (* this should succeed without [Fail], as it does in 8.4 *) diff --git a/test-suite/bugs/opened/4781.v b/test-suite/bugs/opened/4781.v deleted file mode 100644 index 8b651ac22e..0000000000 --- a/test-suite/bugs/opened/4781.v +++ /dev/null @@ -1,94 +0,0 @@ -Ltac force_clear := - clear; - repeat match goal with - | [ H : _ |- _ ] => clear H - | [ H := _ |- _ ] => clearbody H - end. - -Class abstract_term {T} (x : T) := by_abstract_term : T. -Hint Extern 0 (@abstract_term ?T ?x) => force_clear; change T; abstract (exact x) : typeclass_instances. - -Goal True. -(* These work: *) - let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - pose x. - let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - let x := (eval cbv iota in (let v : T := x in v)) in - pose x. - let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - let x := match constr:(Set) with ?y => constr:(y) end in - pose x. -(* This fails with an error: *) - Fail let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - let x := match constr:(x) with ?y => constr:(y) end in - pose x. (* The command has indeed failed with message: -Error: Variable y should be bound to a term. *) -(* And the rest fail with Anomaly: Uncaught exception Not_found. Please report. *) - Fail let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - let x := match constr:(x) with ?y => y end in - pose x. - Fail let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - let x := (eval cbv iota in x) in - pose x. - Fail let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - let x := type of x in - pose x. (* should succeed *) - Fail let term := constr:(I) in - let T := type of term in - let x := constr:(_ : abstract_term term) in - let x := type of x in - pose x. (* should succeed *) - -(*Apparently what [cbv iota] doesn't see can't hurt it, and [pose] is perfectly happy with abstracted lemmas only some of the time. - -Even stranger, consider:*) - let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - let y := (eval cbv iota in (let v : T := x in v)) in - pose y; - let x' := fresh "x'" in - pose x as x'. - let x := (eval cbv delta [x'] in x') in - pose x; - let z := (eval cbv iota in x) in - pose z. - -(*This works fine. But if I change the period to a semicolon, I get:*) - - Fail let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - let y := (eval cbv iota in (let v : T := x in v)) in - pose y; - let x' := fresh "x'" in - pose x as x'; - let x := (eval cbv delta [x'] in x') in - pose x. (* Anomaly: Uncaught exception Not_found. Please report. *) - (* should succeed *) -(*and if I use the second one instead of [pose x] (note that using [idtac] works fine), I get:*) - - Fail let term := constr:(I) in - let T := type of term in - let x := constr:((_ : abstract_term term) : T) in - let y := (eval cbv iota in (let v : T := x in v)) in - pose y; - let x' := fresh "x'" in - pose x as x'; - let x := (eval cbv delta [x'] in x') in - let z := (eval cbv iota in x) in (* Error: Variable x should be bound to a term. *) - idtac. (* should succeed *) diff --git a/test-suite/bugs/opened/4813.v b/test-suite/bugs/opened/4813.v deleted file mode 100644 index 2ac5535934..0000000000 --- a/test-suite/bugs/opened/4813.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Import Program.Tactics. - -Record T := BT { t : Set }. -Record U (x : T) := BU { u : t x -> Prop }. -Program Definition A (H : unit -> Prop) : U (BT unit) := BU _ H. diff --git a/test-suite/bugs/opened/6393.v b/test-suite/bugs/opened/6393.v deleted file mode 100644 index 8d5d092333..0000000000 --- a/test-suite/bugs/opened/6393.v +++ /dev/null @@ -1,11 +0,0 @@ -(* These always worked. *) -Goal prod True True. firstorder. Qed. -Goal True -> @sigT True (fun _ => True). firstorder. Qed. -Goal prod True True. dtauto. Qed. -Goal prod True True. tauto. Qed. - -(* These should work. *) -Goal @sigT True (fun _ => True). dtauto. Qed. -(* These should work, but don't *) -(* Goal @sigT True (fun _ => True). firstorder. Qed. *) -(* Goal @sigT True (fun _ => True). tauto. Qed. *) diff --git a/test-suite/bugs/opened/6602.v b/test-suite/bugs/opened/6602.v deleted file mode 100644 index 3690adf90a..0000000000 --- a/test-suite/bugs/opened/6602.v +++ /dev/null @@ -1,17 +0,0 @@ -Require Import Omega. - -Lemma test_nat: - forall n, (5 + pred n <= 5 + n). -Proof. - intros. - zify. - omega. -Qed. - -Lemma test_N: - forall n, (5 + N.pred n <= 5 + n)%N. -Proof. - intros. - zify. - omega. -Qed. diff --git a/test-suite/bugs/opened/bug_1338.v-disabled b/test-suite/bugs/opened/bug_1338.v-disabled new file mode 100644 index 0000000000..ab0f98202d --- /dev/null +++ b/test-suite/bugs/opened/bug_1338.v-disabled @@ -0,0 +1,12 @@ +Require Import Omega. + +Goal forall x, 0 <= x -> x <= 20 -> +x <> 0 + -> x <> 1 -> x <> 2 -> x <> 3 -> x <>4 -> x <> 5 -> x <> 6 -> x <> 7 -> x <> 8 +-> x <> 9 -> x <> 10 + -> x <> 11 -> x <> 12 -> x <> 13 -> x <> 14 -> x <> 15 -> x <> 16 -> x <> 17 +-> x <> 18 -> x <> 19 -> x <> 20 -> False. +Proof. + intros. + Fail omega. +Abort. diff --git a/test-suite/bugs/opened/bug_1596.v b/test-suite/bugs/opened/bug_1596.v new file mode 100644 index 0000000000..820022d995 --- /dev/null +++ b/test-suite/bugs/opened/bug_1596.v @@ -0,0 +1,260 @@ +Require Import Relations. +Require Import FSets. +Require Import Arith. +Require Import Omega. + +Set Keyed Unification. + +Lemma Bool_elim_bool : forall (b:bool),b=true \/ b=false. + destruct b;try tauto. +Qed. + +Module OrderedPair (X:OrderedType) (Y:OrderedType) <: OrderedType with +Definition t := (X.t * Y.t)%type. + Definition t := (X.t * Y.t)%type. + + Definition eq (xy1:t) (xy2:t) := + let (x1,y1) := xy1 in + let (x2,y2) := xy2 in + (X.eq x1 x2) /\ (Y.eq y1 y2). + + Definition lt (xy1:t) (xy2:t) := + let (x1,y1) := xy1 in + let (x2,y2) := xy2 in + (X.lt x1 x2) \/ ((X.eq x1 x2) /\ (Y.lt y1 y2)). + + Lemma eq_refl : forall (x:t),(eq x x). + destruct x. + unfold eq. + split;[apply X.eq_refl | apply Y.eq_refl]. + Qed. + + Lemma eq_sym : forall (x y:t),(eq x y)->(eq y x). + destruct x;destruct y;unfold eq;intro. + elim H;clear H;intros. + split;[apply X.eq_sym | apply Y.eq_sym];trivial. + Qed. + + Lemma eq_trans : forall (x y z:t),(eq x y)->(eq y z)->(eq x z). + unfold eq;destruct x;destruct y;destruct z;intros. + elim H;clear H;intros. + elim H0;clear H0;intros. + split;[eapply X.eq_trans | eapply Y.eq_trans];eauto. + Qed. + + Lemma lt_trans : forall (x y z:t),(lt x y)->(lt y z)->(lt x z). + unfold lt;destruct x;destruct y;destruct z;intros. + case H;clear H;intro. + case H0;clear H0;intro. + left. + eapply X.lt_trans;eauto. + elim H0;clear H0;intros. + left. + case (X.compare t0 t4);trivial;intros. + generalize (X.eq_sym H0);intro. + generalize (X.eq_trans e H2);intro. + elim (X.lt_not_eq H H3). + generalize (X.lt_trans l H);intro. + generalize (X.eq_sym H0);intro. + elim (X.lt_not_eq H2 H3). + elim H;clear H;intros. + case H0;clear H0;intro. + left. + case (X.compare t0 t4);trivial;intros. + generalize (X.eq_sym H);intro. + generalize (X.eq_trans H2 e);intro. + elim (X.lt_not_eq H0 H3). + generalize (X.lt_trans H0 l);intro. + generalize (X.eq_sym H);intro. + elim (X.lt_not_eq H2 H3). + elim H0;clear H0;intros. + right. + split. + eauto. + eauto. + Qed. + + Lemma lt_not_eq : forall (x y:t),(lt x y)->~(eq x y). + unfold lt, eq;destruct x;destruct y;intro;intro. + elim H0;clear H0;intros. + case H. + intro. + apply (X.lt_not_eq H2 H0). + intro. + elim H2;clear H2;intros. + apply (Y.lt_not_eq H3 H1). + Qed. + + Definition compare : forall (x y:t),(Compare lt eq x y). + destruct x;destruct y. + case (X.compare t0 t2);intro. + apply LT. + left;trivial. + case (Y.compare t1 t3);intro. + apply LT. + right. + tauto. + apply EQ. + split;trivial. + apply GT. + right;auto. + apply GT. + left;trivial. + Defined. + + Definition eq_dec : forall (x y: t), { eq x y } + { ~ eq x y}. + Proof. + intros [xa xb] [ya yb]; simpl. + destruct (X.eq_dec xa ya). + destruct (Y.eq_dec xb yb). + + left; now split. + + right. now intros [eqa eqb]. + + right. now intros [eqa eqb]. + Defined. + + Hint Immediate eq_sym. + Hint Resolve eq_refl eq_trans lt_not_eq lt_trans. +End OrderedPair. + +Module MessageSpi. + Inductive message : Set := + | MNam : nat -> message. + + Definition t := message. + + Fixpoint message_lt (m n:message) {struct m} : Prop := + match (m,n) with + | (MNam n1,MNam n2) => n1 < n2 + end. + + Module Ord <: OrderedType with Definition t := message with Definition eq := +@eq message. + Definition t := message. + Definition eq := @eq message. + Definition lt := message_lt. + + Lemma eq_refl : forall (x:t),eq x x. + unfold eq;auto. + Qed. + + Lemma eq_sym : forall (x y:t),(eq x y )->(eq y x). + unfold eq;auto. + Qed. + + Lemma eq_trans : forall (x y z:t),(eq x y)->(eq y z)->(eq x z). + unfold eq;auto;intros;congruence. + Qed. + + Lemma lt_trans : forall (x y z:t),(lt x y)->(lt y z)->(lt x z). + unfold lt. + induction x;destruct y;simpl;try tauto;destruct z;try tauto;intros. + omega. + Qed. + + Lemma lt_not_eq : forall (x y:t),(lt x y)->~(eq x y). + unfold eq;unfold lt. + induction x;destruct y;simpl;try tauto;intro;red;intro;try (discriminate +H0);injection H0;intros. + elim (lt_irrefl n);try omega. + Qed. + + Definition compare : forall (x y:t),(Compare lt eq x y). + unfold lt, eq. + induction x;destruct y;intros;try (apply LT;simpl;trivial;fail);try +(apply +GT;simpl;trivial;fail). + case (lt_eq_lt_dec n n0);intros;try (case s;clear s;intros). + apply LT;trivial. + apply EQ;trivial. + rewrite e;trivial. + apply GT;trivial. + Defined. + + Definition eq_dec : forall (x y: t), { eq x y } + { ~ eq x y}. + Proof. + intros [i] [j]. unfold eq. + destruct (eq_nat_dec i j). + + left. now f_equal. + + right. intros meq; now inversion meq. + Defined. + + Hint Immediate eq_sym. + Hint Resolve eq_refl eq_trans lt_not_eq lt_trans. + End Ord. + + Theorem eq_dec : forall (m n:message),{m=n}+{~(m=n)}. + intros. + case (Ord.compare m n);intro;[right | left | right];try (red;intro). + elim (Ord.lt_not_eq m n);auto. + rewrite e;auto. + elim (Ord.lt_not_eq n m);auto. + Defined. +End MessageSpi. + +Module MessagePair := OrderedPair MessageSpi.Ord MessageSpi.Ord. + +Module Type Hedge := FSetInterface.S with Module E := MessagePair. + +Module A (H:Hedge). + Definition hedge := H.t. + + Definition message_relation := relation MessageSpi.message. + + Definition relation_of_hedge (h:hedge) (m n:MessageSpi.message) := H.In (m,n) +h. + + Inductive hedge_synthesis_relation (h:message_relation) : message_relation := + | SynInc : forall (m n:MessageSpi.message),(h m +n)->(hedge_synthesis_relation h m n). + + Fixpoint hedge_in_synthesis (h:hedge) (m:MessageSpi.message) +(n:MessageSpi.message) {struct m} : bool := + if H.mem (m,n) h + then true + else false. + + Definition hedge_synthesis_spec (h:hedge) := hedge_synthesis_relation +(relation_of_hedge h). + + Lemma hedge_in_synthesis_impl_hedge_synthesis_spec : forall (h:hedge),forall +(m n:MessageSpi.message),(hedge_in_synthesis h m n)=true->(hedge_synthesis_spec +h m n). + unfold hedge_synthesis_spec;unfold relation_of_hedge. + induction m;simpl;intro. + elim (Bool_elim_bool (H.mem (MessageSpi.MNam n,n0) h));intros. + apply SynInc;apply H.mem_2;trivial. + rewrite H in H0. (* !! possible here !! *) + discriminate H0. + Qed. +End A. + +Module B (H:Hedge). + Definition hedge := H.t. + + Definition message_relation := relation MessageSpi.t. + + Definition relation_of_hedge (h:hedge) (m n:MessageSpi.t) := H.In (m,n) h. + + Inductive hedge_synthesis_relation (h:message_relation) : message_relation := + | SynInc : forall (m n:MessageSpi.t),(h m n)->(hedge_synthesis_relation h m +n). + + Fixpoint hedge_in_synthesis (h:hedge) (m:MessageSpi.t) (n:MessageSpi.t) +{struct m} : bool := + if H.mem (m,n) h + then true + else false. + + Definition hedge_synthesis_spec (h:hedge) := hedge_synthesis_relation +(relation_of_hedge h). + + Lemma hedge_in_synthesis_impl_hedge_synthesis_spec : forall (h:hedge),forall +(m n:MessageSpi.t),(hedge_in_synthesis h m n)=true->(hedge_synthesis_spec h m +n). + unfold hedge_synthesis_spec;unfold relation_of_hedge. + induction m;simpl;intro. + elim (Bool_elim_bool (H.mem (MessageSpi.MNam n,n0) h));intros. + apply SynInc;apply H.mem_2;trivial. + rewrite H in H0. discriminate. (* !! impossible here !! *) + Qed. +End B. diff --git a/test-suite/bugs/opened/bug_1615.v b/test-suite/bugs/opened/bug_1615.v new file mode 100644 index 0000000000..c045335410 --- /dev/null +++ b/test-suite/bugs/opened/bug_1615.v @@ -0,0 +1,11 @@ +Require Import Omega. + +Lemma foo : forall n m : Z, (n >= 0)%Z -> (n * m >= 0)%Z -> (n <= n + n * m)%Z. +Proof. + intros. omega. +Qed. + +Lemma foo' : forall n m : nat, n <= n + n * m. +Proof. + intros. Fail omega. +Abort. diff --git a/test-suite/bugs/opened/bug_1671.v b/test-suite/bugs/opened/bug_1671.v new file mode 100644 index 0000000000..b4e653f687 --- /dev/null +++ b/test-suite/bugs/opened/bug_1671.v @@ -0,0 +1,12 @@ +(* Exemple soumis par Pierre Corbineau (bug #1671) *) + +CoInductive hdlist : unit -> Type := +| cons : hdlist tt -> hdlist tt. + +Variable P : forall bo, hdlist bo -> Prop. +Variable all : forall bo l, P bo l. + +Fail Definition F (l:hdlist tt) : P tt l := +match l in hdlist u return P u l with +| cons (cons l') => all tt _ +end. diff --git a/test-suite/bugs/opened/bug_1811.v b/test-suite/bugs/opened/bug_1811.v new file mode 100644 index 0000000000..57c1744313 --- /dev/null +++ b/test-suite/bugs/opened/bug_1811.v @@ -0,0 +1,10 @@ +Require Export Bool. + +Lemma neg2xor : forall b, xorb true b = negb b. +Proof. auto. Qed. + +Goal forall b1 b2, (negb b1 = b2) -> xorb true b1 = b2. +Proof. + intros b1 b2. + Fail rewrite neg2xor. +Abort. diff --git a/test-suite/bugs/opened/bug_2572.v-disabled b/test-suite/bugs/opened/bug_2572.v-disabled new file mode 100644 index 0000000000..3f6c6a0d14 --- /dev/null +++ b/test-suite/bugs/opened/bug_2572.v-disabled @@ -0,0 +1,187 @@ +Require Import List. +Definition is_dec (P:Prop) := {P}+{~P}. +Definition eq_dec (T:Type) := forall (t1 t2:T), is_dec (t1=t2). + +Record Label : Type := mkLabel { + LabElem: Type; + LabProd: LabElem -> LabElem -> option LabElem; + LabBot: LabElem -> Prop; + LabError: LabElem -> Prop +}. + +Definition LProd (L1 L2: Label): Label := {| + LabElem := LabElem L1 * LabElem L2; + LabProd := fun lg ld => let (lg1,lg2) := lg in let (ld1,ld2) := ld in + match LabProd L1 lg1 ld1, LabProd L2 lg2 ld2 with + Some g, Some d => Some (g,d) + | _,_ => None + end; + LabBot l := let (l1,l2) := l in LabBot L1 l1 \/ LabBot L2 l2; + LabError l := let (l1,l2) := l in LabError L1 l1 \/ LabError L2 l2 +|}. + +Definition Lrestrict (L: Label) (S: LabElem L -> bool): Label := {| + LabElem := LabElem L; + LabProd l1 l2 := if andb (S l1) (S l2) then LabProd L l1 l2 else None; + LabBot l := LabBot L l; + LabError l := LabError L l +|}. + +Notation "l1 ^* l2" := (LProd l1 l2) (at level 50). + +Record LTS(L:Type): Type := mkLTS { + State: Type; + Init: State -> Prop; + Next: State -> L -> State -> Prop +}. +Implicit Arguments State. +Implicit Arguments Init. +Implicit Arguments Next. + +Definition sound L (S: LTS (LabElem L)): Prop := + forall s s' l, Next S s l s' -> ~LabError L l. + +Inductive PNext L (S1 S2:LTS (LabElem L)): State S1 * State S2 -> (LabElem L) -> State S1 * State S2 -> Prop := + LNext: forall s1 s2 l1 s'1, Next S1 s1 l1 s'1 -> (forall l2, LabProd L l1 l2 = None) -> + PNext L S1 S2 (s1,s2) l1 (s'1,s2) +| RNext: forall s1 s2 l2 s'2, (forall l1, LabProd L l1 l2 = None) -> Next S2 s2 l2 s'2 -> + PNext L S1 S2 (s1,s2) l2 (s1,s'2) +| SNext: forall s1 s2 l1 l2 l s'1 s'2, Next S1 s1 l1 s'1 -> Next S2 s2 l2 s'2 -> + Some l = LabProd L l1 l2 -> PNext L S1 S2 (s1,s2) l (s'1,s'2). + +Definition Produit (L:Label) (S1 S2: LTS (LabElem L)): LTS (LabElem L) := {| + State := State S1 * State S2; + Init := fun s => let (s1,s2) := s in Init S1 s1 /\ Init S2 s2; + Next :=PNext L S1 S2 +|}. + +Parameter Time: Type. +Parameter teq: forall t1 t2:Time, {t1=t2}+{t1<>t2}. + +Inductive TLabElem(L:Type): Type := + Tdiscrete: L -> TLabElem L +| Tdelay: Time -> TLabElem L +| Tbot: TLabElem L. + +Definition TLabel L: Label := {| + LabElem := TLabElem (LabElem L); + LabProd lt1 lt2 := + match lt1, lt2 with + Tdiscrete l1, Tdiscrete l2 => match (LabProd L l1 l2) with Some l => Some (Tdiscrete (LabElem L) l) | None => None end + | Tdelay t1, Tdelay t2 => if teq t1 t2 then Some (Tdelay (LabElem L) t1) else Some (Tbot (LabElem L)) + | _,_ => None + end; + LabBot lt := match lt with + Tdiscrete l => LabBot L l + | Tbot => True + | _ => False + end; + LabError lt := match lt with + Tdiscrete l => LabError L l + | _ => False + end + |}. + +Parameter Var: Type. +Parameter allv: forall P, (forall (v:Var), is_dec (P v)) -> is_dec (forall v, P v). +Parameter DType: Type. +Parameter Data: DType -> Type. +Parameter vtype: Var -> DType. +Parameter Deq: forall t (d1 d2: Data t), is_dec (d1=d2). + +Inductive Vctr(v:Var): Type := + Wctr: Data (vtype v) -> Vctr v +| Rctr: Data (vtype v) -> Vctr v +| Fctr: Vctr v +| Nctr: Vctr v. + +Definition isCmp v (c1 c2: Vctr v): Prop := + match c1,c2 with + Wctr _, Nctr => True + | Rctr _, Rctr _ => True + | Rctr _, Nctr => True + | Rctr _, Fctr => True + | Nctr, _ => True + | _,_ => False + end. + +Lemma isCmp_dec: forall v (c1 c2: Vctr v), is_dec (isCmp v c1 c2). +intros. +induction c1; induction c2; simpl; intros; try (left; tauto); try (right; tauto). +Qed. + +Definition Vprod v (c1 c2: Vctr v): (isCmp v c1 c2) -> Vctr v := + match c1,c2 return isCmp v c1 c2 -> Vctr v with + | Wctr d, Nctr => fun h => Wctr v d + | Rctr d1, Rctr d2 => fun h => if Deq (vtype v) d1 d2 then Rctr v d1 else Fctr v + | Rctr d1, Nctr => fun h => Rctr v d1 + | Rctr d1, Fctr => fun h => Fctr v + | Fctr, Rctr _ => fun h => Fctr v + | Fctr, Fctr => fun h => Fctr v + | Fctr, Nctr => fun h => Fctr v + | Nctr, c2 => fun h => c2 + | _,_ => fun h => match h with end + end. + +Inductive MLabElem: Type := + Mctr: (forall v, Vctr v) -> MLabElem +| Merr: MLabElem. + +Definition MProd (m1 m2: MLabElem): MLabElem := + match m1,m2 with + Mctr c1, Mctr c2 => match allv (fun v => isCmp v (c1 v) (c2 v)) (fun v => isCmp_dec v (c1 v) (c2 v)) with + left h => Mctr (fun v => Vprod v (c1 v) (c2 v) (h v)) + | _ => Merr + end + | _,_ => Merr + end. + +Definition MLabel: Label := {| + LabElem := MLabElem; + LabProd m1 m2 := Some (MProd m1 m2); + LabBot m := exists c, m = Mctr c /\ exists v, c v = Fctr v; + LabError m := m = Merr +|}. + +Parameter Chan: Type. +Parameter ch_eq: eq_dec Chan. + +Definition CLabel(S: Chan->bool): Label := {| + LabElem := Chan; + LabProd := fun c1 c2 => if ch_eq c1 c2 then if S c1 then Some c1 else None else None; + LabBot := fun _ => False; + LabError := fun _ => False +|}. + +Definition FLabel(S: Chan->bool): Label := + TLabel (CLabel S ^* MLabel ^* MLabel ^* MLabel). + +Definition FTS := LTS (LabElem (FLabel (fun _ => true))). +Check (fun S (T1 T2: FTS) => Produit (FLabel S) T1 T2). +(* +Definition PAR (S: Chan -> bool) (T1 T2: FTS): FTS. +unfold FTS in *; simpl in *. +apply (Produit (FLabel S)). +apply T1. +apply T2. +Defined. + +Definition PAR (S: Chan -> bool) (T1 T2: FTS): FTS := + Produit (FLabel S) T1 T2. +*) +Lemma FTSirrel (S: Chan -> bool): FTS = LTS (LabElem (FLabel S)). +Proof. + unfold FTS. + simpl. + reflexivity. +Qed. + +Definition PAR (S: Chan -> bool) (T1 T2: FTS): FTS. +revert T2; revert T1. +rewrite (FTSirrel S). +apply (Produit (FLabel S)). +Defined. + +Record HTTS: Type := mkHTTS { + +}. diff --git a/test-suite/bugs/opened/bug_3010.v-disabled b/test-suite/bugs/opened/bug_3010.v-disabled new file mode 100644 index 0000000000..f2906bd6a6 --- /dev/null +++ b/test-suite/bugs/opened/bug_3010.v-disabled @@ -0,0 +1 @@ +Definition em {A R} (k : forall s : sum A _, match s with inl x => R x | inr y => R end) := k (inr (fun x => k (inl x))). \ No newline at end of file diff --git a/test-suite/bugs/opened/bug_3092.v b/test-suite/bugs/opened/bug_3092.v new file mode 100644 index 0000000000..9db21d156e --- /dev/null +++ b/test-suite/bugs/opened/bug_3092.v @@ -0,0 +1,9 @@ +Fail Fixpoint le_pred (n1 n2 : nat) (H1 : n1 <= n2) : pred n1 <= pred n2 := + match H1 with + | le_n => le_n (pred _) + | le_S _ H2 => + match n2 with + | 0 => fun H3 => H3 + | S _ => le_S _ _ + end (le_pred _ _ H2) + end. diff --git a/test-suite/bugs/opened/bug_3166.v b/test-suite/bugs/opened/bug_3166.v new file mode 100644 index 0000000000..e1c29a954c --- /dev/null +++ b/test-suite/bugs/opened/bug_3166.v @@ -0,0 +1,83 @@ +Set Asymmetric Patterns. + +Section eq. + Let A := { X : Type & X }. + Let B := (fun x : A => projT1 x). + Let T := (fun (a' : A) (b' : B a') => projT2 a' = b'). + Let T' := T. + Let t1T := (fun _ : A => unit). + Let f1 := (fun x (_ : t1T x) => projT2 x). + Let t1 := (fun x (y : t1T x) => @eq_refl (projT1 x) (projT2 x)). + Let t1T' := t1T. + Let f1' := f1. + Let t1' := t1. + + Theorem eq_matches_commute + a' b' (t' : T a' b') + (rta : forall b'', T' a' b'' -> A) + (rtb : forall b'' t'', B (rta b'' t'')) + (rt1 : forall y, T _ (rtb (f1' a' y) (@t1' a' y))) + (R : forall (b : B (rta b' t')), T _ b -> Type) + (r1 : forall y, R (f1 _ y) (@t1 _ y)) + : match + match t' as t0' in (@eq _ _ b0') return T (rta b0' t0') (rtb b0' t0') with + | eq_refl => rt1 tt + end + as t0 in (@eq _ _ b0) + return R b0 t0 + with + | eq_refl => r1 tt + end + = + match t' + as t0' in (@eq _ _ b0') + return (forall (R : forall (b : B (rta b0' t0')), T _ b -> Type) + (r1 : forall y, R (f1 _ y) (@t1 _ y)), + R _ (match t0' as t0'0 in (@eq _ _ b0'0) return T (rta b0'0 t0'0) (rtb b0'0 t0'0) with + | eq_refl => rt1 tt + end)) + with + | eq_refl => fun _ r1 => + match rt1 tt with + | eq_refl => r1 tt + end + end R r1. + Proof. + destruct t'; reflexivity. + Defined. + + Theorem eq_match_beta2 + a b (t : T a b) + X + (R : forall b' (t' : T a b'), X b' -> Type) + (r1 : forall y x, R _ (@t1 _ y) x) + x + : match t as t' in (@eq _ _ b') return forall x, R b' t' x with + | eq_refl => r1 tt + end (x b) + = + match t as t' in (@eq _ _ b') return R b' t' (x b') with + | eq_refl => r1 tt (x _) + end. + Proof. + destruct t; reflexivity. + Defined. +End eq. + +Definition typeof {T} (_ : T) := T. + +Eval compute in (eq_sym (eq_sym _)). +Goal forall T (x y : T) (p : x = y), True. + intros. + pose proof + (@eq_matches_commute + (existT (fun T => T) T x) y p + (fun b'' _ => existT (fun T => T) T b'') + (fun _ _ => x) + (fun _ => eq_refl) + (fun x' _ => x' = y) + (fun _ => eq_refl) + ) as H0. + compute in H0. + change (fun (x' : T) (_ : y = x') => x' = y) with ((fun y => fun (x' : T) (_ : y = x') => x' = y) y) in H0. + Fail pose proof (fun k => @eq_trans _ _ _ k H0). diff --git a/test-suite/bugs/opened/bug_3186.v-disabled b/test-suite/bugs/opened/bug_3186.v-disabled new file mode 100644 index 0000000000..d0bcb920cc --- /dev/null +++ b/test-suite/bugs/opened/bug_3186.v-disabled @@ -0,0 +1,4 @@ +Fixpoint a (_:unit):= +match eq_refl with +|eq_refl => a +end. \ No newline at end of file diff --git a/test-suite/bugs/opened/bug_3248.v b/test-suite/bugs/opened/bug_3248.v new file mode 100644 index 0000000000..33c408a28c --- /dev/null +++ b/test-suite/bugs/opened/bug_3248.v @@ -0,0 +1,17 @@ +Ltac ret_and_left f := + let tac := ret_and_left in + let T := type of f in + lazymatch eval hnf in T with + | ?T' -> _ => + let ret := constr:(fun x' : T' => ltac:(tac (f x'))) in + exact ret + | ?T' => exact f + end. + +Goal forall A B : Prop, forall x y : A, True. +Proof. + intros A B x y. + pose (f := fun (x y : A) => conj x y). + pose (a := ltac:(ret_and_left f)). + Fail unify (a x y) (conj x y). +Abort. diff --git a/test-suite/bugs/opened/bug_3277.v b/test-suite/bugs/opened/bug_3277.v new file mode 100644 index 0000000000..5f4231363a --- /dev/null +++ b/test-suite/bugs/opened/bug_3277.v @@ -0,0 +1,7 @@ +Tactic Notation "evarr" open_constr(x) := let y := constr:(x) in exact y. + +Goal True. + evarr _. +Admitted. +Goal True. + Fail exact ltac:(evarr _). (* Error: Cannot infer this placeholder. *) diff --git a/test-suite/bugs/opened/bug_3278.v b/test-suite/bugs/opened/bug_3278.v new file mode 100644 index 0000000000..1c6deae94b --- /dev/null +++ b/test-suite/bugs/opened/bug_3278.v @@ -0,0 +1,25 @@ +Module a. + Check let x' := _ in + ltac:(exact x'). + + Notation foo x := (let x' := x in ltac:(exact x')). + + Fail Check foo _. (* Error: +Cannot infer an internal placeholder of type "Type" in environment: + +x' := ?42 : ?41 +. *) +End a. + +Module b. + Notation foo x := (let x' := x in let y := (ltac:(exact I) : True) in I). + Notation bar x := (let x' := x in let y := (I : True) in I). + + Check let x' := _ in ltac:(exact I). (* let x' := ?5 in I *) + Check bar _. (* let x' := ?9 in let y := I in I *) + Fail Check foo _. (* Error: +Cannot infer an internal placeholder of type "Type" in environment: + +x' := ?42 : ?41 +. *) +End b. diff --git a/test-suite/bugs/opened/bug_3283.v b/test-suite/bugs/opened/bug_3283.v new file mode 100644 index 0000000000..3ab5416e8c --- /dev/null +++ b/test-suite/bugs/opened/bug_3283.v @@ -0,0 +1,28 @@ +Notation "P |-- Q" := (@eq nat P Q) (at level 80, Q at level 41, no associativity) . +Notation "x &&& y" := (plus x y) (at level 40, left associativity, y at next level) . +Notation "'Ex' x , P " := (plus x P) (at level 65, x at level 99, P at level 80). + +(* Succeed *) +Check _ |-- _ &&& _ -> _. +Check _ |-- _ &&& (Ex _, _ ) -> _. +Check _ |-- (_ &&& Ex _, _ ) -> _. + +(* Why does this fail? *) +Fail Check _ |-- _ &&& Ex _, _ -> _. +(* The command has indeed failed with message: +=> Error: The term "Ex ?17, ?18" has type "nat" +which should be Set, Prop or Type. *) + +(* Just in case something is strange with -> *) +Notation "P ----> Q" := (P -> Q) (right associativity, at level 99, Q at next level). + +(* Succeed *) +Check _ |-- _ &&& _ ----> _. +Check _ |-- _ &&& (Ex _, _ ) ----> _. +Check _ |-- (_ &&& Ex _, _ ) ----> _. + +(* Why does this fail? *) +Fail Check _ |-- _ &&& Ex _, _ ----> _. +(* The command has indeed failed with message: +=> Error: The term "Ex ?31, ?32" has type "nat" +which should be Set, Prop or Type.*) diff --git a/test-suite/bugs/opened/bug_3295.v b/test-suite/bugs/opened/bug_3295.v new file mode 100644 index 0000000000..c09649de73 --- /dev/null +++ b/test-suite/bugs/opened/bug_3295.v @@ -0,0 +1,104 @@ +Require Export Morphisms Setoid. + +Class lops := lmk_ops { + car: Type; + weq: relation car +}. + +Arguments car : clear implicits. + +Coercion car: lops >-> Sortclass. + +Instance weq_Equivalence `{lops}: Equivalence weq. +Proof. +Admitted. + +Module lset. +Canonical Structure lset_ops A := lmk_ops (list A) (fun h k => True). +End lset. + +Class ops := mk_ops { + ob: Type; + mor: ob -> ob -> lops; + dot: forall n m p, mor n m -> mor m p -> mor n p +}. +Coercion mor: ops >-> Funclass. +Arguments ob : clear implicits. + +Instance dot_weq `{ops} n m p: Proper (weq ==> weq ==> weq) (dot n m p). +Proof. +Admitted. + +Section s. + +Import lset. + +Context `{X:lops} {I: Type}. + +Axiom sup : forall (f: I -> X) (J : list I), X. + +Global Instance sup_weq: Proper (pointwise_relation _ weq ==> weq ==> weq) sup. +Proof. +Admitted. + +End s. + +Axiom ord : forall (n : nat), Type. +Axiom seq : forall n, list (ord n). + +Infix "==" := weq (at level 79). +Infix "*" := (dot _ _ _) (left associativity, at level 40). + +Notation "∑_ ( i ∈ l ) f" := (@sup (mor _ _) _ (fun i => f) l) + (at level 41, f at level 41, i, l at level 50). + +Axiom dotxsum : forall `{X : ops} I J n m p (f: I -> X m n) (x: X p m) y, + x * (∑_(i∈ J) f i) == y. + +Definition mx X n m := ord n -> ord m -> X. + +Section bsl. +Context `{X : ops} {u: ob X}. +Notation U := (car (@mor X u u)). + +Lemma toto n m p q (M : mx U n m) N (P : mx U p q) Q i j : ∑_(j0 ∈ seq m) M i j0 * (∑_(j1 ∈ seq p) N j0 j1 * P j1 j) == Q. +Proof. + Fail setoid_rewrite dotxsum. + (* Toplevel input, characters 0-22: +Error: +Tactic failure:setoid rewrite failed: Unable to satisfy the rewriting constraints. +Unable to satisfy the following constraints: +UNDEFINED EVARS: + ?101==[X u n m p q M N P Q i j j0 |- U] (goal evar) + ?106==[X u n m p q M N P Q i j |- relation (X u u)] (internal placeholder) + ?107==[X u n m p q M N P Q i j |- relation (list (ord m))] + (internal placeholder) + ?108==[X u n m p q M N P Q i j (do_subrelation:=do_subrelation) + |- Proper (pointwise_relation (ord m) weq ==> ?107 ==> ?106) sup] + (internal placeholder) + ?109==[X u n m p q M N P Q i j |- ProperProxy ?107 (seq m)] + (internal placeholder) + ?110==[X u n m p q M N P Q i j |- relation (X u u)] (internal placeholder) + ?111==[X u n m p q M N P Q i j (do_subrelation:=do_subrelation) + |- Proper (?106 ==> ?110 ==> Basics.flip Basics.impl) weq] + (internal placeholder) + ?112==[X u n m p q M N P Q i j |- ProperProxy ?110 Q] (internal placeholder)UNIVERSES: + {} |= Top.14 <= Top.37 + Top.25 <= Top.24 + Top.25 <= Top.32 + +ALGEBRAIC UNIVERSES:{} +UNDEFINED UNIVERSES:METAS: + 470[y] := ?101 : car (?99 ?467 ?465) + 469[x] := M i _UNBOUND_REL_1 : car (?99 ?467 ?466) [type is checked] + 468[f] := fun i : ?463 => N _UNBOUND_REL_2 i * P i j : + ?463 -> ?99 ?466 ?465 [type is checked] + 467[p] := u : ob ?99 [type is checked] + 466[m] := u : ob ?99 [type is checked] + 465[n] := u : ob ?99 [type is checked] + 464[J] := seq p : list ?463 [type is checked] + 463[I] := ord p : Type [type is checked] + *) +Abort. + +End bsl. diff --git a/test-suite/bugs/opened/bug_3304.v b/test-suite/bugs/opened/bug_3304.v new file mode 100644 index 0000000000..66668930c7 --- /dev/null +++ b/test-suite/bugs/opened/bug_3304.v @@ -0,0 +1,3 @@ +Fail Notation "( x , y , .. , z )" := ltac:(let r := constr:(prod .. (prod x y) .. z) in r). +(* The command has indeed failed with message: +=> Error: Special token .. is for use in the Notation command. *) diff --git a/test-suite/bugs/opened/bug_3311.v b/test-suite/bugs/opened/bug_3311.v new file mode 100644 index 0000000000..1c66bc1e55 --- /dev/null +++ b/test-suite/bugs/opened/bug_3311.v @@ -0,0 +1,10 @@ +Require Import Setoid. +Axiom bar : True = False. +Goal True. + Fail setoid_rewrite bar. (* Toplevel input, characters 15-33: +Error: +Tactic failure:setoid rewrite failed: Unable to satisfy the rewriting constraints. + +Could not find an instance for "subrelation eq (Basics.flip Basics.impl)". +With the following constraints: +?3 : "True" *) diff --git a/test-suite/bugs/opened/bug_3312.v b/test-suite/bugs/opened/bug_3312.v new file mode 100644 index 0000000000..749921e2f6 --- /dev/null +++ b/test-suite/bugs/opened/bug_3312.v @@ -0,0 +1,5 @@ +Require Import Setoid. +Axiom bar : 0 = 1. +Goal 0 = 1. + Fail rewrite_strat bar. (* Toplevel input, characters 15-32: +Error: Tactic failure:setoid rewrite failed: Nothing to rewrite. *) diff --git a/test-suite/bugs/opened/bug_3343.v b/test-suite/bugs/opened/bug_3343.v new file mode 100644 index 0000000000..6c5a85f9cf --- /dev/null +++ b/test-suite/bugs/opened/bug_3343.v @@ -0,0 +1,46 @@ +(* File reduced by coq-bug-finder from original input, then from 13699 lines to 656 lines, then from 584 lines to 200 lines *) +Set Asymmetric Patterns. +Require Export Coq.Lists.List. +Export List.ListNotations. + +Record CFGV := { Terminal : Type; VarSym : Type }. + +Section Gram. + Context {G : CFGV}. + + Inductive Pattern : (Terminal G) -> Type := + | ptleaf : forall (T : Terminal G), + nat -> Pattern T + with Mixture : list (Terminal G) -> Type := + | mtcons : forall {h: Terminal G} + {tl: list (Terminal G)}, + Pattern h -> Mixture tl -> Mixture (h::tl). + + Variable vc : VarSym G. + + Fixpoint pBVars {gs} (p : Pattern gs) : (list nat) := + match p with + | ptleaf _ _ => [] + end + with mBVars {lgs} (pts : Mixture lgs) : (list nat) := + match pts with + | mtcons _ _ _ tl => mBVars tl + end. + + Lemma mBndngVarsAsNth : + forall mp (m : @Mixture mp), + mBVars m = [2]. + Proof. + intros. + induction m. progress simpl. + Admitted. +End Gram. + +Lemma mBndngVarsAsNth' {G : CFGV} { vc : VarSym G} : + forall mp (m : @Mixture G mp), + mBVars m = [2]. +Proof. + intros. + induction m. + Fail progress simpl. + (* simpl did nothing here, while it does something inside the section; this is probably a bug*) diff --git a/test-suite/bugs/opened/bug_3345.v b/test-suite/bugs/opened/bug_3345.v new file mode 100644 index 0000000000..3e3da6df71 --- /dev/null +++ b/test-suite/bugs/opened/bug_3345.v @@ -0,0 +1,145 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 1972 lines to 136 lines, then from 119 lines to 105 lines *) +Global Set Implicit Arguments. +Require Import Coq.Lists.List Program. +Section IndexBound. + Context {A : Set}. + Class IndexBound (a : A) (Bound : list A) := + { ibound :> nat; + boundi : nth_error Bound ibound = Some a}. + Global Arguments ibound [a Bound] _ . + Global Arguments boundi [a Bound] _. + Record BoundedIndex (Bound : list A) := { bindex :> A; indexb :> IndexBound bindex Bound }. +End IndexBound. +Context {A : Type} {C : Set}. +Variable (projAC : A -> C). +Lemma None_neq_Some +: forall (AnyT AnyT' : Type) (a : AnyT), + None = Some a -> AnyT'. + admit. +Defined. +Program Definition nth_Bounded' + (Bound : list A) + (c : C) + (a_opt : option A) + (nth_n : option_map projAC a_opt = Some c) +: A := match a_opt as x + return (option_map projAC x = Some c) -> A with + | Some a => fun _ => a + | None => fun f : None = Some _ => ! + end nth_n. +Lemma nth_error_map : + forall n As c_opt, + nth_error (map projAC As) n = c_opt + -> option_map projAC (nth_error As n) = c_opt. + admit. +Defined. +Definition nth_Bounded + (Bound : list A) + (idx : BoundedIndex (map projAC Bound)) +: A := nth_Bounded' Bound (nth_error Bound (ibound idx)) + (nth_error_map _ _ (boundi idx)). +Program Definition nth_Bounded_ind2 + (P : forall As, BoundedIndex (map projAC As) + -> BoundedIndex (map projAC As) + -> A -> A -> Prop) +: forall (Bound : list A) + (idx : BoundedIndex (map projAC Bound)) + (idx' : BoundedIndex (map projAC Bound)), + match nth_error Bound (ibound idx), nth_error Bound (ibound idx') with + | Some a, Some a' => P Bound idx idx' a a' + | _, _ => True + end + -> P Bound idx idx' (nth_Bounded _ idx) (nth_Bounded _ idx'):= + fun Bound idx idx' => + match (nth_error Bound (ibound idx)) as e, (nth_error Bound (ibound idx')) as e' + return + (forall (f : option_map _ e = Some (bindex idx)) + (f' : option_map _ e' = Some (bindex idx')), + (match e, e' with + | Some a, Some a' => P Bound idx idx' a a' + | _, _ => True + end) + -> P Bound idx idx' + (match e as e'' return + option_map _ e'' = Some (bindex idx) + -> A + with + | Some a => fun _ => a + | _ => fun f => _ + end f) + (match e' as e'' return + option_map _ e'' = Some (bindex idx') + -> A + with + | Some a => fun _ => a + | _ => fun f => _ + end f')) with + | Some a, Some a' => fun _ _ H => _ + | _, _ => fun f => _ + end (nth_error_map _ _ (boundi idx)) + (nth_error_map _ _ (boundi idx')). + +Lemma nth_Bounded_eq +: forall (Bound : list A) + (idx idx' : BoundedIndex (map projAC Bound)), + ibound idx = ibound idx' + -> nth_Bounded Bound idx = nth_Bounded Bound idx'. +Proof. + intros. + eapply nth_Bounded_ind2 with (idx := idx) (idx' := idx'). + simpl. + (* The [case_eq] should not Fail. More importantly, [Fail case_eq ...] should succeed if [case_eq ...] fails. It doesn't!!! So I resort to [Fail Fail try (case_eq ...)]. *) + Fail Fail try (case_eq (nth_error Bound (ibound idx'))). +(* Toplevel input, characters 15-54: +In nested Ltac calls to "case_eq" and "pattern x at - 1", last call failed. +Error: The abstracted term +"fun e : Exc A => + forall e0 : nth_error Bound (ibound idx') = e, + match + nth_error Bound (ibound idx) as anonymous'0 + return (anonymous'0 = nth_error Bound (ibound idx) -> e = e -> Prop) + with + | Some a => + match + e as anonymous' + return + (Some a = nth_error Bound (ibound idx) -> anonymous' = e -> Prop) + with + | Some a' => + fun (_ : Some a = nth_error Bound (ibound idx)) (_ : Some a' = e) => + a = a' + | None => + fun (_ : Some a = nth_error Bound (ibound idx)) (_ : None = e) => + True + end + | None => fun (_ : None = nth_error Bound (ibound idx)) (_ : e = e) => True + end eq_refl e0" is not well typed. +Illegal application: +The term + "match + nth_error Bound (ibound idx) as anonymous'0 + return (anonymous'0 = nth_error Bound (ibound idx) -> e = e -> Prop) + with + | Some a => + match + e as anonymous' + return + (Some a = nth_error Bound (ibound idx) -> anonymous' = e -> Prop) + with + | Some a' => + fun (_ : Some a = nth_error Bound (ibound idx)) (_ : Some a' = e) => + a = a' + | None => + fun (_ : Some a = nth_error Bound (ibound idx)) (_ : None = e) => + True + end + | None => fun (_ : None = nth_error Bound (ibound idx)) (_ : e = e) => True + end" of type + "nth_error Bound (ibound idx) = nth_error Bound (ibound idx) -> + e = e -> Prop" +cannot be applied to the terms + "eq_refl" : "nth_error Bound (ibound idx) = nth_error Bound (ibound idx)" + "e0" : "nth_error Bound (ibound idx') = e" +The 2nd term has type "nth_error Bound (ibound idx') = e" +which should be coercible to "e = e". *) diff --git a/test-suite/bugs/opened/bug_3357.v b/test-suite/bugs/opened/bug_3357.v new file mode 100644 index 0000000000..c479158877 --- /dev/null +++ b/test-suite/bugs/opened/bug_3357.v @@ -0,0 +1,9 @@ +Notation D1 := (forall {T : Type} ( x : T ) , Type). + +Definition DD1 ( A : forall {T : Type} (x : T), Type ) := A 1. +Fail Definition DD1' ( A : D1 ) := A 1. (* Toplevel input, characters 32-33: +Error: In environment +A : forall T : Type, T -> Type +The term "1" has type "nat" while it is expected to have type +"Type". + *) diff --git a/test-suite/bugs/opened/bug_3363.v b/test-suite/bugs/opened/bug_3363.v new file mode 100644 index 0000000000..800d89573c --- /dev/null +++ b/test-suite/bugs/opened/bug_3363.v @@ -0,0 +1,26 @@ +(** In this file, either all four [Check]s should fail, or all four should succeed. *) +Module A. + Section HexStrings. + Require Import String. + End HexStrings. + Fail Check string. +End A. + +Module B. + Section HexStrings. + Require String. + Import String. + End HexStrings. + Fail Check string. +End B. + +Section HexStrings. + Require String. + Import String. +End HexStrings. +Fail Check string. + +Section HexStrings'. + Require Import String. +End HexStrings'. +Check string. diff --git a/test-suite/bugs/opened/bug_3370.v b/test-suite/bugs/opened/bug_3370.v new file mode 100644 index 0000000000..4964bf96c0 --- /dev/null +++ b/test-suite/bugs/opened/bug_3370.v @@ -0,0 +1,12 @@ +Require Import String. + +Local Ltac set_strings := + let s := match goal with |- context[String ?s1 ?s2] => constr:(String s1 s2) end in + let H := fresh s in + set (H := s). + +Local Open Scope string_scope. + +Goal "asdf" = "bds". +Fail set_strings. (* Error: Ltac variable s is bound to "asdf" which cannot be coerced to +a fresh identifier. *) diff --git a/test-suite/bugs/opened/bug_3395.v b/test-suite/bugs/opened/bug_3395.v new file mode 100644 index 0000000000..5ca48fc9d6 --- /dev/null +++ b/test-suite/bugs/opened/bug_3395.v @@ -0,0 +1,231 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from originally 10918 lines, then 3649 lines to 3177 lines, then from 3189 lines to 3164 lines, then from 2653 lines to 2496 lines, 2653 lines, then from 1642 lines to 651 lines, then from 736 lines to 473 lines, then from 433 lines to 275 lines, then from 258 lines to 235 lines. *) +Generalizable All Variables. +Set Implicit Arguments. + +Arguments fst {_ _} _. +Arguments snd {_ _} _. + +Axiom cheat : forall {T}, T. + +Reserved Notation "g 'o' f" (at level 40, left associativity). + +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y" := (paths x y) : type_scope. + +Definition symmetry {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. +Record PreCategory (object : Type) := + Build_PreCategory' { + object :> Type := object; + morphism : object -> object -> Type; + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g); + associativity : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + (m3 o m2) o m1 = m3 o (m2 o m1); + associativity_sym : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + m3 o (m2 o m1) = (m3 o m2) o m1; + left_identity : forall a b (f : morphism a b), identity b o f = f; + right_identity : forall a b (f : morphism a b), f o identity a = f; + identity_identity : forall x, identity x o identity x = identity x + }. +Bind Scope category_scope with PreCategory. +Arguments PreCategory {_}. +Arguments identity {_} [!C%category] x%object : rename. + +Arguments compose {_} [!C%category s%object d%object d'%object] m1%morphism m2%morphism : rename. + +Infix "o" := compose : morphism_scope. + +Delimit Scope functor_scope with functor. +Local Open Scope morphism_scope. +Record Functor `(C : @PreCategory objC, D : @PreCategory objD) := + { + object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d); + composition_of : forall s d d' + (m1 : morphism C s d) (m2: morphism C d d'), + morphism_of _ _ (m2 o m1) + = (morphism_of _ _ m2) o (morphism_of _ _ m1); + identity_of : forall x, morphism_of _ _ (identity x) + = identity (object_of x) + }. +Bind Scope functor_scope with Functor. + +Arguments morphism_of {_} [C%category] {_} [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. + +Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. + +Class IsIsomorphism `{C : @PreCategory objC} {s d} (m : morphism C s d) := + { + morphism_inverse : morphism C d s; + left_inverse : morphism_inverse o m = identity _; + right_inverse : m o morphism_inverse = identity _ + }. + +Definition opposite `(C : @PreCategory objC) : PreCategory + := @Build_PreCategory' + C + (fun s d => morphism C d s) + (identity (C := C)) + (fun _ _ _ m1 m2 => m2 o m1) + (fun _ _ _ _ _ _ _ => @associativity_sym _ _ _ _ _ _ _ _ _) + (fun _ _ _ _ _ _ _ => @associativity _ _ _ _ _ _ _ _ _) + (fun _ _ => @right_identity _ _ _ _) + (fun _ _ => @left_identity _ _ _ _) + (@identity_identity _ C). + +Notation "C ^op" := (opposite C) (at level 3) : category_scope. + +Definition prod `(C : @PreCategory objC, D : @PreCategory objD) : @PreCategory (objC * objD). + refine (@Build_PreCategory' + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) + * morphism D (snd s) (snd d))%type) + (fun x => (identity (fst x), identity (snd x))) + (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1)) + _ + _ + _ + _ + _); admit. +Defined. +Infix "*" := prod : category_scope. + +Definition compose_functor `(C : @PreCategory objC, D : @PreCategory objD, E : @PreCategory objE) (G : Functor D E) (F : Functor C D) : Functor C E + := Build_Functor + C E + (fun c => G (F c)) + (fun _ _ m => morphism_of G (morphism_of F m)) + cheat + cheat. + +Infix "o" := compose_functor : functor_scope. + +Record NaturalTransformation `(C : @PreCategory objC, D : @PreCategory objD) (F G : Functor C D) := + Build_NaturalTransformation' { + components_of :> forall c, morphism D (F c) (G c); + commutes : forall s d (m : morphism C s d), + components_of d o F _1 m = G _1 m o components_of s; + + commutes_sym : forall s d (m : C.(morphism) s d), + G _1 m o components_of s = components_of d o F _1 m + }. +Definition functor_category `(C : @PreCategory objC, D : @PreCategory objD) : PreCategory + := @Build_PreCategory' (Functor C D) + (@NaturalTransformation _ C _ D) + cheat + cheat + cheat + cheat + cheat + cheat + cheat. + +Definition opposite_functor `(F : @Functor objC C objD D) : Functor C^op D^op + := Build_Functor (C^op) (D^op) + (object_of F) + (fun s d => morphism_of F (s := d) (d := s)) + (fun d' d s m1 m2 => composition_of F s d d' m2 m1) + (identity_of F). + +Definition opposite_invL `(F : @Functor objC C^op objD D) : Functor C D^op + := Build_Functor C (D^op) + (object_of F) + (fun s d => morphism_of F (s := d) (d := s)) + (fun d' d s m1 m2 => composition_of F s d d' m2 m1) + (identity_of F). +Notation "F ^op" := (opposite_functor F) : functor_scope. + +Notation "F ^op'L" := (opposite_invL F) (at level 3) : functor_scope. +Definition fst `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) C + := Build_Functor (C * D) C + (@fst _ _) + (fun _ _ => @fst _ _) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). + +Definition snd `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) D + := Build_Functor (C * D) D + (@snd _ _) + (fun _ _ => @snd _ _) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). +Definition prod_functor `(F : @Functor objC C objD D, F' : @Functor objC C objD' D') +: Functor C (D * D') + := Build_Functor + C (D * D') + (fun c => (F c, F' c)) + (fun s d m => (F _1 m, F' _1 m))%morphism + cheat + cheat. +Definition pair `(F : @Functor objC C objD D, F' : @Functor objC' C' objD' D') : Functor (C * C') (D * D') + := (prod_functor (F o fst) (F' o snd))%functor. +Notation cat_of obj := + (@Build_PreCategory' obj + (fun x y => forall _ : x, y) + (fun _ x => x) + (fun _ _ _ f g x => f (g x))%core + (fun _ _ _ _ _ _ _ => idpath) + (fun _ _ _ _ _ _ _ => idpath) + (fun _ _ _ => idpath) + (fun _ _ _ => idpath) + (fun _ => idpath)). + +Definition hom_functor `(C : @PreCategory objC) : Functor (C^op * C) (cat_of Type) + := Build_Functor _ _ cheat cheat cheat cheat. + +Definition induced_hom_natural_transformation `(F : @Functor objC C objD D) +: NaturalTransformation (hom_functor C) (hom_functor D o pair F^op F) + := Build_NaturalTransformation' _ _ cheat cheat cheat. + +Class IsFullyFaithful `(F : @Functor objC C objD D) + := is_fully_faithful + : forall x y : C, + IsIsomorphism (induced_hom_natural_transformation F (x, y)). + +Definition coyoneda `(A : @PreCategory objA) : Functor A^op (@functor_category _ A _ (cat_of Type)) + := cheat. + +Definition yoneda `(A : @PreCategory objA) : Functor A (@functor_category _ A^op _ (cat_of Type)) + := (((coyoneda A^op)^op'L)^op'L)%functor. +Definition coyoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@coyoneda _ A). +Admitted. + +Definition yoneda_embedding_fast `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A). +Proof. + intros a b. + pose proof (coyoneda_embedding A^op a b) as CYE. + unfold yoneda. + Time let t := (type of CYE) in + let t' := (eval simpl in t) in pose proof ((fun (x : t) => (x : t')) CYE) as CYE'. (* Finished transaction in 0. secs (0.216013u,0.004s) *) + Fail Timeout 1 let t := match goal with |- ?G => constr:(G) end in + let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE'). + Time let t := match goal with |- ?G => constr:(G) end in + let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE'). (* Finished transaction in 0. secs (0.248016u,0.s) *) +Fail Timeout 2 Defined. +Time Defined. (* Finished transaction in 1. secs (0.432027u,0.s) *) + +Definition yoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A). +Proof. + intros a b. + pose proof (coyoneda_embedding A^op a b) as CYE. + unfold yoneda; simpl in *. + Fail Timeout 1 exact CYE. + Time exact CYE. (* Finished transaction in 0. secs (0.012001u,0.s) *) diff --git a/test-suite/bugs/opened/bug_3424.v b/test-suite/bugs/opened/bug_3424.v new file mode 100644 index 0000000000..d1c5bb68f9 --- /dev/null +++ b/test-suite/bugs/opened/bug_3424.v @@ -0,0 +1,24 @@ +Set Universe Polymorphism. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Class Contr_internal (A : Type) := BuildContr { center : A ; contr : (forall y : A, center = y) }. +Inductive trunc_index : Type := minus_two | trunc_S (x : trunc_index). +Bind Scope trunc_scope with trunc_index. +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. +Notation minus_one:=(trunc_S minus_two). +Notation "0" := (trunc_S minus_one) : trunc_scope. +Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. +Notation IsHProp := (IsTrunc minus_one). +Notation IsHSet := (IsTrunc 0). +Goal forall (A : Type) (a b : A) (H' : IsHSet A), { x : Type & IsHProp x }. +Proof. +intros. +eexists. +(* exact (H' a b). *) +(* Undo. *) +Fail apply (H' a b). +exact (H' a b). +Qed. diff --git a/test-suite/bugs/opened/bug_3459.v b/test-suite/bugs/opened/bug_3459.v new file mode 100644 index 0000000000..762611f751 --- /dev/null +++ b/test-suite/bugs/opened/bug_3459.v @@ -0,0 +1,31 @@ +(* Bad interaction between clear and the typability of ltac constr bindings *) + +(* Original report *) + +Goal 1 = 2. +Proof. +(* This line used to fail with a Not_found up to some point, and then + to produce an ill-typed term *) +match goal with + | [ |- context G[2] ] => let y := constr:(fun x => ltac:(let r := constr:(@eq Set x x) in + clear x; + exact r)) in + pose y +end. +(* Add extra test for typability (should not fail when bug closed) *) +Fail match goal with P:?c |- _ => try (let x := type of c in idtac) || fail 2 end. +Abort. + +(* Second report raising a Not_found at the time of 21 Oct 2014 *) + +Section F. + +Variable x : nat. + +Goal True. +evar (e : Prop). +assert e. +Fail let r := constr:(eq_refl x) in clear x; exact r. +Abort. + +End F. diff --git a/test-suite/bugs/opened/bug_3463.v b/test-suite/bugs/opened/bug_3463.v new file mode 100644 index 0000000000..124f2bcc03 --- /dev/null +++ b/test-suite/bugs/opened/bug_3463.v @@ -0,0 +1,12 @@ +Tactic Notation "test1" open_constr(t) ident(r):= + pose t. +Tactic Notation "test2" constr(r) open_constr(t):= + pose t. +Tactic Notation "test3" open_constr(t) constr(r):= + pose t. + +Goal True. + test1 (1 + _) nat. + test2 nat (1 + _). + test3 (1 + _) nat. + test3 (1 + _ : nat) nat. diff --git a/test-suite/bugs/opened/bug_3478.v-disabled b/test-suite/bugs/opened/bug_3478.v-disabled new file mode 100644 index 0000000000..cc926b2167 --- /dev/null +++ b/test-suite/bugs/opened/bug_3478.v-disabled @@ -0,0 +1,8 @@ +Set Primitive Projections. +Record foo := { foom :> Type }. +Canonical Structure default_foo := fun T => {| foom := T |}. +Record bar T := { bar1 : T }. +Goal forall (s : foo) (x : foom s), True. +Proof. + intros. + Timeout 1 pose (x : bar _) as x'. \ No newline at end of file diff --git a/test-suite/bugs/opened/bug_3626.v b/test-suite/bugs/opened/bug_3626.v new file mode 100644 index 0000000000..46a6c009eb --- /dev/null +++ b/test-suite/bugs/opened/bug_3626.v @@ -0,0 +1,7 @@ +Set Implicit Arguments. +Set Primitive Projections. +Record prod A B := pair { fst : A ; snd : B }. + +Fail Goal forall x y : prod Set Set, x.(@fst) = y.(@fst). +(* intros. + apply f_equal. *) diff --git a/test-suite/bugs/opened/bug_3655.v b/test-suite/bugs/opened/bug_3655.v new file mode 100644 index 0000000000..841f77febb --- /dev/null +++ b/test-suite/bugs/opened/bug_3655.v @@ -0,0 +1,9 @@ +Ltac bar x := pose x. +Tactic Notation "foo" open_constr(x) := bar x. +Class baz := { baz' : Type }. +Goal True. +(* Original error was an anomaly which is fixed; now, it succeeds but + leaving an evar, while calling pose would not leave an evar, so I + guess it is still a bug in the sense that the semantics of pose is + not preserved *) + foo baz'. diff --git a/test-suite/bugs/opened/bug_3754.v b/test-suite/bugs/opened/bug_3754.v new file mode 100644 index 0000000000..a717bbe735 --- /dev/null +++ b/test-suite/bugs/opened/bug_3754.v @@ -0,0 +1,284 @@ +Unset Strict Universe Declaration. +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 9113 lines to 279 lines *) +(* coqc version trunk (October 2014) compiled on Oct 19 2014 18:56:9 with OCaml 3.12.1 + coqtop version trunk (October 2014) *) + +Notation Type0 := Set. + +Notation idmap := (fun x => x). + +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. + +Notation pr1 := projT1. + +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. + +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := + fun x => g (f x). + +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. +Open Scope function_scope. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x. +admit. +Defined. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Notation "1" := idpath : path_scope. + +Notation "p @ q" := (concat p q) (at level 20) : path_scope. + +Notation "p ^" := (inverse p) (at level 3, format "p '^'") : path_scope. + +Notation "p @' q" := (concat p q) (at level 21, left associativity, + format "'[v' p '/' '@'' q ']'") : long_path_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y. +exact (match p with idpath => u end). +Defined. + +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y. +exact (match p with idpath => idpath end). +Defined. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) +}. + +Arguments eisretr {A B} f {_} _. + +Record Equiv A B := BuildEquiv { + equiv_fun : A -> B ; + equiv_isequiv : IsEquiv equiv_fun +}. + +Coercion equiv_fun : Equiv >-> Funclass. + +Global Existing Instance equiv_isequiv. + +Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) +}. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. +Local Open Scope trunc_scope. +Notation "-2" := minus_two (at level 0) : trunc_scope. +Notation "-1" := (-2.+1) (at level 0) : trunc_scope. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | -2 => Contr_internal A + | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. +Notation IsHProp := (IsTrunc -1). + +Monomorphic Axiom dummy_funext_type : Type0. +Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. + +Local Open Scope path_scope. + +Definition concat_p1 {A : Type} {x y : A} (p : x = y) : + p @ 1 = p + := + match p with idpath => 1 end. + +Definition concat_1p {A : Type} {x y : A} (p : x = y) : + 1 @ p = p + := + match p with idpath => 1 end. + +Definition concat_p_pp {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z = t) : + p @ (q @ r) = (p @ q) @ r := + match r with idpath => + match q with idpath => + match p with idpath => 1 + end end end. + +Definition concat_pp_p {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z = t) : + (p @ q) @ r = p @ (q @ r) := + match r with idpath => + match q with idpath => + match p with idpath => 1 + end end end. + +Definition moveL_Mp {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x) : + r^ @ q = p -> q = r @ p. +admit. +Defined. + +Ltac with_rassoc tac := + repeat rewrite concat_pp_p; + tac; + + repeat rewrite concat_p_pp. + +Ltac rewrite_moveL_Mp_p := with_rassoc ltac:(apply moveL_Mp). + +Definition ap_p_pp {A B : Type} (f : A -> B) {w : B} {x y z : A} + (r : w = f x) (p : x = y) (q : y = z) : + r @ (ap f (p @ q)) = (r @ ap f p) @ (ap f q). +admit. +Defined. + +Definition ap_compose {A B C : Type} (f : A -> B) (g : B -> C) {x y : A} (p : x = y) : + ap (g o f) p = ap g (ap f p) + := + match p with idpath => 1 end. + +Definition concat_Ap {A B : Type} {f g : A -> B} (p : forall x, f x = g x) {x y : A} (q : x = y) : + (ap f q) @ (p y) = (p x) @ (ap g q) + := + match q with + | idpath => concat_1p _ @ ((concat_p1 _) ^) + end. + +Definition transportD2 {A : Type} (B C : A -> Type) (D : forall a:A, B a -> C a -> Type) + {x1 x2 : A} (p : x1 = x2) (y : B x1) (z : C x1) (w : D x1 y z) + : D x2 (p # y) (p # z) + := + match p with idpath => w end. +Local Open Scope equiv_scope. + +Definition transport_arrow_toconst {A : Type} {B : A -> Type} {C : Type} + {x1 x2 : A} (p : x1 = x2) (f : B x1 -> C) (y : B x2) + : (transport (fun x => B x -> C) p f) y = f (p^ # y). +admit. +Defined. + +Definition transport_arrow_fromconst {A B : Type} {C : A -> Type} + {x1 x2 : A} (p : x1 = x2) (f : B -> C x1) (y : B) + : (transport (fun x => B -> C x) p f) y = p # (f y). +admit. +Defined. + +Definition ap_transport_arrow_toconst {A : Type} {B : A -> Type} {C : Type} + {x1 x2 : A} (p : x1 = x2) (f : B x1 -> C) {y1 y2 : B x2} (q : y1 = y2) + : ap (transport (fun x => B x -> C) p f) q + @ transport_arrow_toconst p f y2 + = transport_arrow_toconst p f y1 + @ ap (fun y => f (p^ # y)) q. +admit. +Defined. + +Class Univalence. +Definition path_universe {A B : Type} (f : A -> B) {feq : IsEquiv f} : (A = B). +admit. +Defined. +Definition transport_path_universe + {A B : Type} (f : A -> B) {feq : IsEquiv f} (z : A) + : transport (fun X:Type => X) (path_universe f) z = f z. +admit. +Defined. +Definition transport_path_universe_V `{Funext} + {A B : Type} (f : A -> B) {feq : IsEquiv f} (z : B) + : transport (fun X:Type => X) (path_universe f)^ z = f^-1 z. +admit. +Defined. + +Ltac simpl_do_clear tac term := + let H := fresh in + assert (H := term); + simpl in H |- *; + tac H; + clear H. + +Tactic Notation "simpl" "rewrite" constr(term) := simpl_do_clear ltac:(fun H => rewrite H) term. + +Global Instance Univalence_implies_Funext `{Univalence} : Funext. +Admitted. + +Section Factorization. + + Context {class1 class2 : forall (X Y : Type@{i}), (X -> Y) -> Type@{i}} + `{forall (X Y : Type@{i}) (g:X->Y), IsHProp (class1 _ _ g)} + `{forall (X Y : Type@{i}) (g:X->Y), IsHProp (class2 _ _ g)} + {A B : Type@{i}} {f : A -> B}. + + Record Factorization := + { intermediate : Type ; + factor1 : A -> intermediate ; + factor2 : intermediate -> B ; + fact_factors : factor2 o factor1 == f ; + inclass1 : class1 _ _ factor1 ; + inclass2 : class2 _ _ factor2 + }. + + Record PathFactorization {fact fact' : Factorization} := + { path_intermediate : intermediate fact <~> intermediate fact' ; + path_factor1 : path_intermediate o factor1 fact == factor1 fact' ; + path_factor2 : factor2 fact == factor2 fact' o path_intermediate ; + path_fact_factors : forall a, path_factor2 (factor1 fact a) + @ ap (factor2 fact') (path_factor1 a) + @ fact_factors fact' a + = fact_factors fact a + }. + Context `{Univalence} {fact fact' : Factorization} + (pf : @PathFactorization fact fact'). + + Let II := path_intermediate pf. + Let ff1 := path_factor1 pf. + Let ff2 := path_factor2 pf. +Local Definition II' : intermediate fact = intermediate fact'. +admit. +Defined. + + Local Definition fff' (a : A) + : (transportD2 (fun X => A -> X) (fun X => X -> B) + (fun X g h => {_ : forall a : A, h (g a) = f a & + {_ : class1 A X g & class2 X B h}}) + II' (factor1 fact) (factor2 fact) + (fact_factors fact; (inclass1 fact; inclass2 fact))).1 a = + ap (transport (fun X => X -> B) II' (factor2 fact)) + (transport_arrow_fromconst II' (factor1 fact) a + @ transport_path_universe II (factor1 fact a) + @ ff1 a) + @ transport_arrow_toconst II' (factor2 fact) (factor1 fact' a) + @ ap (factor2 fact) (transport_path_universe_V II (factor1 fact' a)) + @ ff2 (II^-1 (factor1 fact' a)) + @ ap (factor2 fact') (eisretr II (factor1 fact' a)) + @ fact_factors fact' a. + Proof. + + Open Scope long_path_scope. + + rewrite (ap_transport_arrow_toconst (B := idmap) (C := B)). + + simpl rewrite (@ap_compose _ _ _ (transport idmap (path_universe II)^) + (factor2 fact)). + rewrite <- ap_p_pp; rewrite_moveL_Mp_p. + Set Debug Tactic Unification. + Fail rewrite (concat_Ap ff2). diff --git a/test-suite/bugs/opened/bug_3794.v b/test-suite/bugs/opened/bug_3794.v new file mode 100644 index 0000000000..e4711a38c0 --- /dev/null +++ b/test-suite/bugs/opened/bug_3794.v @@ -0,0 +1,7 @@ +Hint Extern 10 ((?X = ?Y) -> False) => intros; discriminate. +Hint Unfold not : core. + +Goal true<>false. +Set Typeclasses Debug. +Fail typeclasses eauto with core. +Abort. diff --git a/test-suite/bugs/opened/bug_3889.v b/test-suite/bugs/opened/bug_3889.v new file mode 100644 index 0000000000..6b287324cc --- /dev/null +++ b/test-suite/bugs/opened/bug_3889.v @@ -0,0 +1,11 @@ +Require Import Program. + +Inductive Even : nat -> Prop := +| evenO : Even O +| evenS : forall n, Odd n -> Even (S n) +with Odd : nat -> Prop := +| oddS : forall n, Even n -> Odd (S n). +Axiom admit : forall {T}, T. +Program Fixpoint doubleE {n} (e : Even n) : Even (2 * n) := admit +with doubleO {n} (o : Odd n) : Odd (S (2 * n)) := _. +Next Obligation of doubleE. diff --git a/test-suite/bugs/opened/bug_3890.v b/test-suite/bugs/opened/bug_3890.v new file mode 100644 index 0000000000..5c74addb62 --- /dev/null +++ b/test-suite/bugs/opened/bug_3890.v @@ -0,0 +1,18 @@ +Class Foo. +Class Bar := b : Type. + +Instance foo : Foo := _. +(* 1 subgoals, subgoal 1 (ID 4) + + ============================ + Foo *) + +Instance bar : Bar. +exact Type. +Defined. +(* bar is defined *) + +About foo. +(* foo not a defined object. *) + +Fail Defined. diff --git a/test-suite/bugs/opened/bug_3919.v-disabled b/test-suite/bugs/opened/bug_3919.v-disabled new file mode 100644 index 0000000000..0d661de9c4 --- /dev/null +++ b/test-suite/bugs/opened/bug_3919.v-disabled @@ -0,0 +1,13 @@ +Require Import MSets. +Require Import Orders. + +Declare Module Signal : OrderedType. + +Module S := MSetAVL.Make(Signal). +Module Sdec := Decide(S). +Export Sdec. + +Hint Extern 0 (Signal.eq ?x ?y) => now symmetry. + +Goal forall o s, Signal.eq o s. +Proof. fsetdec. Qed. diff --git a/test-suite/bugs/opened/bug_3922.v-disabled b/test-suite/bugs/opened/bug_3922.v-disabled new file mode 100644 index 0000000000..ce4f509cad --- /dev/null +++ b/test-suite/bugs/opened/bug_3922.v-disabled @@ -0,0 +1,83 @@ +Set Universe Polymorphism. +Notation Type0 := Set. + +Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. +Open Scope function_scope. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) +}. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. +Local Open Scope trunc_scope. +Notation "-2" := minus_two (at level 0) : trunc_scope. +Notation "-1" := (-2.+1) (at level 0) : trunc_scope. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | -2 => Contr_internal A + | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Notation Contr := (IsTrunc -2). +Notation IsHProp := (IsTrunc -1). + +Monomorphic Axiom dummy_funext_type : Type0. +Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. + +Inductive Unit : Type1 := + tt : Unit. + +Record TruncType (n : trunc_index) := BuildTruncType { + trunctype_type : Type ; + istrunc_trunctype_type : IsTrunc n trunctype_type +}. + +Arguments BuildTruncType _ _ {_}. + +Coercion trunctype_type : TruncType >-> Sortclass. + +Notation "n -Type" := (TruncType n) (at level 1) : type_scope. +Notation hProp := (-1)-Type. + +Notation BuildhProp := (BuildTruncType -1). + +Private Inductive Trunc (n : trunc_index) (A :Type) : Type := + tr : A -> Trunc n A. +Arguments tr {n A} a. + +Global Instance istrunc_truncation (n : trunc_index) (A : Type@{i}) +: IsTrunc@{j} n (Trunc@{i} n A). +Admitted. + +Definition Trunc_ind {n A} + (P : Trunc n A -> Type) {Pt : forall aa, IsTrunc n (P aa)} + : (forall a, P (tr a)) -> (forall aa, P aa) +:= (fun f aa => match aa with tr a => fun _ => f a end Pt). +Definition merely (A : Type@{i}) : hProp@{i} := BuildhProp (Trunc -1 A). +Definition cconst_factors_contr `{Funext} {X Y : Type} (f : X -> Y) + (P : Type) `{Pc : X -> Contr P} + (g : X -> P) (h : P -> Y) (p : h o g == f) +: Unit. +Proof. + assert (merely X -> IsHProp P) by admit. + refine (let g' := Trunc_ind (fun _ => P) g : merely X -> P in _); + [ assumption.. | ]. + Fail pose (g' := Trunc_ind (fun _ => P) g : merely X -> P). diff --git a/test-suite/bugs/opened/bug_3928.v-disabled b/test-suite/bugs/opened/bug_3928.v-disabled new file mode 100644 index 0000000000..b470eb229b --- /dev/null +++ b/test-suite/bugs/opened/bug_3928.v-disabled @@ -0,0 +1,12 @@ +Typeclasses eauto := bfs. + +Class Foo := {}. +Class Bar := {}. + +Instance: Bar. +Instance: Foo -> Bar -> Foo -> Foo | 1. +Instance: Bar -> Foo | 100. +Instance: Foo -> Bar -> Foo -> Foo | 1. + +Set Typeclasses Debug. +Timeout 1 Check (_ : Foo). (* timeout *) diff --git a/test-suite/bugs/opened/bug_3938.v b/test-suite/bugs/opened/bug_3938.v new file mode 100644 index 0000000000..2d0d1930f1 --- /dev/null +++ b/test-suite/bugs/opened/bug_3938.v @@ -0,0 +1,6 @@ +Require Import Coq.Arith.PeanoNat. +Hint Extern 1 => admit : typeclass_instances. +Goal forall a b (f : nat -> Set), Nat.eq a b -> f a = f b. + intros a b f H. + rewrite H. (* Toplevel input, characters 15-25: +Anomaly: Evar ?X11 was not declared. Please report. *) diff --git a/test-suite/bugs/opened/bug_3946.v b/test-suite/bugs/opened/bug_3946.v new file mode 100644 index 0000000000..e77bdbc652 --- /dev/null +++ b/test-suite/bugs/opened/bug_3946.v @@ -0,0 +1,11 @@ +Require Import ZArith. + +Inductive foo := Foo : Z.le 0 1 -> foo. + +Definition bar (f : foo) := let (f) := f in f. + +(* Doesn't work: *) +(* Arguments bar f.*) + +(* Does work *) +Arguments bar f _. diff --git a/test-suite/bugs/opened/bug_4701.v b/test-suite/bugs/opened/bug_4701.v new file mode 100644 index 0000000000..9286f0f1f0 --- /dev/null +++ b/test-suite/bugs/opened/bug_4701.v @@ -0,0 +1,23 @@ +(*Suppose we have*) + + Inductive my_if {A B} : bool -> Type := + | then_case (_ : A) : my_if true + | else_case (_ : B) : my_if false. + Notation "'If' b 'Then' A 'Else' B" := (@my_if A B b) (at level 10). + +(*then here are three inductive type declarations that work:*) + + Inductive I1 := + | i1 (x : I1). + Inductive I2 := + | i2 (x : nat). + Inductive I3 := + | i3 (b : bool) (x : If b Then I3 Else nat). + +(*and here is one that does not, despite being equivalent to [I3]:*) + + Fail Inductive I4 := + | i4 (b : bool) (x : if b then I4 else nat). (* Error: Non strictly positive occurrence of "I4" in + "forall b : bool, (if b then I4 else nat) -> I4". *) + +(*I think this one should work. I believe this is a conservative extension over CIC: Since [match] statements returning types can always be re-encoded as inductive type families, the analysis should be independent of whether the constructor uses an inductive or a [match] statement.*) diff --git a/test-suite/bugs/opened/bug_4721.v b/test-suite/bugs/opened/bug_4721.v new file mode 100644 index 0000000000..1f184b3930 --- /dev/null +++ b/test-suite/bugs/opened/bug_4721.v @@ -0,0 +1,13 @@ +Variables S1 S2 : Set. + +Goal @eq Type S1 S2 -> @eq Type S1 S2. +intro H. +Fail tauto. +assumption. +Qed. + +(*This is in 8.5pl1, and Matthieq Sozeau says: "That's a regression in tauto indeed, which now requires exact equality of the universes, through a non linear goal pattern matching: +match goal with ?X1 |- ?X1 forces both instances of X1 to be convertible, +with no additional universe constraints currently, but the two types are +initially different. This can be fixed easily to allow the same flexibility +as in 8.4 (or assumption) to unify the universes as well."*) diff --git a/test-suite/bugs/opened/bug_4728.v b/test-suite/bugs/opened/bug_4728.v new file mode 100644 index 0000000000..230b4beb6c --- /dev/null +++ b/test-suite/bugs/opened/bug_4728.v @@ -0,0 +1,72 @@ +(*I'd like the final [Check] in the following to work:*) + +Ltac fin_eta_expand := + [ > lazymatch goal with + | [ H : _ |- _ ] => clear H + end.. + | lazymatch goal with + | [ H : ?T |- ?T ] + => exact H + | [ |- ?G ] + => fail 0 "No hypothesis matching" G + end ]; + let n := numgoals in + tryif constr_eq numgoals 0 + then idtac + else fin_eta_expand. + +Ltac pre_eta_expand x := + let T := type of x in + let G := match goal with |- ?G => G end in + unify T G; + unshelve econstructor; + destruct x; + fin_eta_expand. + +Ltac eta_expand x := + let v := constr:(ltac:(pre_eta_expand x)) in + idtac v; + let v := (eval cbv beta iota zeta in v) in + exact v. + +Notation eta_expand x := (ltac:(eta_expand x)) (only parsing). + +Ltac partial_unify eqn := + lazymatch eqn with + | ?x = ?x => idtac + | ?f ?x = ?g ?y + => partial_unify (f = g); + (tryif unify x y then + idtac + else tryif has_evar x then + unify x y + else tryif has_evar y then + unify x y + else + idtac) + | ?x = ?y + => idtac; + (tryif unify x y then + idtac + else tryif has_evar x then + unify x y + else tryif has_evar y then + unify x y + else + idtac) + end. + +Tactic Notation "{" open_constr(old_record) "with" open_constr(new_record) "}" := + let old_record' := eta_expand old_record in + partial_unify (old_record = new_record); + eexact new_record. + +Set Implicit Arguments. +Record prod A B := pair { fst : A ; snd : B }. +Infix "*" := prod : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. + +Notation "{ old 'with' new }" := (ltac:({ old with new })) (only parsing). + +Check ltac:({ (1, 1) with {| snd := 2 |} }). +Fail Check { (1, 1) with {| snd := 2 |} }. (* Error: Cannot infer this placeholder of type "Type"; should succeed *) diff --git a/test-suite/bugs/opened/bug_4755.v b/test-suite/bugs/opened/bug_4755.v new file mode 100644 index 0000000000..9cc0d361ea --- /dev/null +++ b/test-suite/bugs/opened/bug_4755.v @@ -0,0 +1,34 @@ +(*I'm not sure which behavior is better. But if the change is intentional, it should be documented (I don't think it is), and it'd be nice if there were a flag for this, or if -compat 8.4 restored the old behavior.*) + +Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. +Definition f (v : option nat) := match v with + | Some k => Some k + | None => None + end. + +Axioms F G : (option nat -> option nat) -> Prop. +Axiom FG : forall f, f None = None -> F f = G f. + +Axiom admit : forall {T}, T. + +Existing Instance eq_Reflexive. + +Global Instance foo (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +Global Instance bar (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> eq ==> Basics.flip Basics.impl) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. +Proof. + intro. + pose proof (_ : (Proper (_ ==> eq ==> _) and)). + Fail setoid_rewrite (FG _ _); []. (* In 8.5: Error: Tactic failure: Incorrect number of goals (expected 2 tactics); works in 8.4 *) diff --git a/test-suite/bugs/opened/bug_4771.v b/test-suite/bugs/opened/bug_4771.v new file mode 100644 index 0000000000..396d74bdbf --- /dev/null +++ b/test-suite/bugs/opened/bug_4771.v @@ -0,0 +1,22 @@ +Module Type Foo. + +Parameter Inline t : nat. + +End Foo. + +Module F(X : Foo). + +Tactic Notation "foo" ref(x) := idtac. + +Ltac g := foo X.t. + +End F. + +Module N. +Definition t := 0 + 0. +End N. + +Module K := F(N). + +(* Was +Anomaly: Uncaught exception Not_found. Please report. *) diff --git a/test-suite/bugs/opened/bug_4778.v b/test-suite/bugs/opened/bug_4778.v new file mode 100644 index 0000000000..633d158e96 --- /dev/null +++ b/test-suite/bugs/opened/bug_4778.v @@ -0,0 +1,35 @@ +Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. +Definition f (v : option nat) := match v with + | Some k => Some k + | None => None + end. + +Axioms F G : (option nat -> option nat) -> Prop. +Axiom FG : forall f, f None = None -> F f = G f. + +Axiom admit : forall {T}, T. + +Existing Instance eq_Reflexive. + +(* This instance is needed in 8.4, but is useless in 8.5 *) +Global Instance foo (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +(* +(* This is required in 8.5, but useless in 8.4 *) +Global Instance bar (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> eq ==> Basics.flip Basics.impl) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. +*) + +Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. Proof. + intro. + pose proof (_ : (Proper (_ ==> eq ==> _) and)). + Fail setoid_rewrite (FG _ _); [ | reflexivity.. ]. (* this should succeed without [Fail], as it does in 8.4 *) diff --git a/test-suite/bugs/opened/bug_4781.v b/test-suite/bugs/opened/bug_4781.v new file mode 100644 index 0000000000..8b651ac22e --- /dev/null +++ b/test-suite/bugs/opened/bug_4781.v @@ -0,0 +1,94 @@ +Ltac force_clear := + clear; + repeat match goal with + | [ H : _ |- _ ] => clear H + | [ H := _ |- _ ] => clearbody H + end. + +Class abstract_term {T} (x : T) := by_abstract_term : T. +Hint Extern 0 (@abstract_term ?T ?x) => force_clear; change T; abstract (exact x) : typeclass_instances. + +Goal True. +(* These work: *) + let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + pose x. + let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := (eval cbv iota in (let v : T := x in v)) in + pose x. + let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := match constr:(Set) with ?y => constr:(y) end in + pose x. +(* This fails with an error: *) + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := match constr:(x) with ?y => constr:(y) end in + pose x. (* The command has indeed failed with message: +Error: Variable y should be bound to a term. *) +(* And the rest fail with Anomaly: Uncaught exception Not_found. Please report. *) + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := match constr:(x) with ?y => y end in + pose x. + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := (eval cbv iota in x) in + pose x. + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := type of x in + pose x. (* should succeed *) + Fail let term := constr:(I) in + let T := type of term in + let x := constr:(_ : abstract_term term) in + let x := type of x in + pose x. (* should succeed *) + +(*Apparently what [cbv iota] doesn't see can't hurt it, and [pose] is perfectly happy with abstracted lemmas only some of the time. + +Even stranger, consider:*) + let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let y := (eval cbv iota in (let v : T := x in v)) in + pose y; + let x' := fresh "x'" in + pose x as x'. + let x := (eval cbv delta [x'] in x') in + pose x; + let z := (eval cbv iota in x) in + pose z. + +(*This works fine. But if I change the period to a semicolon, I get:*) + + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let y := (eval cbv iota in (let v : T := x in v)) in + pose y; + let x' := fresh "x'" in + pose x as x'; + let x := (eval cbv delta [x'] in x') in + pose x. (* Anomaly: Uncaught exception Not_found. Please report. *) + (* should succeed *) +(*and if I use the second one instead of [pose x] (note that using [idtac] works fine), I get:*) + + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let y := (eval cbv iota in (let v : T := x in v)) in + pose y; + let x' := fresh "x'" in + pose x as x'; + let x := (eval cbv delta [x'] in x') in + let z := (eval cbv iota in x) in (* Error: Variable x should be bound to a term. *) + idtac. (* should succeed *) diff --git a/test-suite/bugs/opened/bug_4813.v b/test-suite/bugs/opened/bug_4813.v new file mode 100644 index 0000000000..2ac5535934 --- /dev/null +++ b/test-suite/bugs/opened/bug_4813.v @@ -0,0 +1,5 @@ +Require Import Program.Tactics. + +Record T := BT { t : Set }. +Record U (x : T) := BU { u : t x -> Prop }. +Program Definition A (H : unit -> Prop) : U (BT unit) := BU _ H. diff --git a/test-suite/bugs/opened/bug_6393.v b/test-suite/bugs/opened/bug_6393.v new file mode 100644 index 0000000000..8d5d092333 --- /dev/null +++ b/test-suite/bugs/opened/bug_6393.v @@ -0,0 +1,11 @@ +(* These always worked. *) +Goal prod True True. firstorder. Qed. +Goal True -> @sigT True (fun _ => True). firstorder. Qed. +Goal prod True True. dtauto. Qed. +Goal prod True True. tauto. Qed. + +(* These should work. *) +Goal @sigT True (fun _ => True). dtauto. Qed. +(* These should work, but don't *) +(* Goal @sigT True (fun _ => True). firstorder. Qed. *) +(* Goal @sigT True (fun _ => True). tauto. Qed. *) diff --git a/test-suite/bugs/opened/bug_6602.v b/test-suite/bugs/opened/bug_6602.v new file mode 100644 index 0000000000..3690adf90a --- /dev/null +++ b/test-suite/bugs/opened/bug_6602.v @@ -0,0 +1,17 @@ +Require Import Omega. + +Lemma test_nat: + forall n, (5 + pred n <= 5 + n). +Proof. + intros. + zify. + omega. +Qed. + +Lemma test_N: + forall n, (5 + N.pred n <= 5 + n)%N. +Proof. + intros. + zify. + omega. +Qed. diff --git a/test-suite/interactive/4289.v b/test-suite/interactive/4289.v deleted file mode 100644 index 610a509c9b..0000000000 --- a/test-suite/interactive/4289.v +++ /dev/null @@ -1,14 +0,0 @@ -(* Checking backtracking with modules which used to fail due to an - hash-consing bug *) - -Module Type A. - Axiom B : nat. -End A. -Module C (a : A). - Include a. - Definition c : nat := B. -End C. -Back 4. -Module C (a : A). - Include a. - Definition c : nat := B. diff --git a/test-suite/interactive/bug_4289.v b/test-suite/interactive/bug_4289.v new file mode 100644 index 0000000000..610a509c9b --- /dev/null +++ b/test-suite/interactive/bug_4289.v @@ -0,0 +1,14 @@ +(* Checking backtracking with modules which used to fail due to an + hash-consing bug *) + +Module Type A. + Axiom B : nat. +End A. +Module C (a : A). + Include a. + Definition c : nat := B. +End C. +Back 4. +Module C (a : A). + Include a. + Definition c : nat := B. -- cgit v1.2.3 From 1b06197525c2a3a5be8c6b20eef3227fa5ef3dc8 Mon Sep 17 00:00:00 2001 From: Vincent Laporte Date: Wed, 3 Oct 2018 07:21:53 +0000 Subject: test-suite: rename a few files --- test-suite/failure/guard-cofix.v | 43 ---- test-suite/failure/guard_cofix.v | 43 ++++ test-suite/failure/prop-set-proof-irrelevance.v | 12 -- test-suite/failure/prop_set_proof_irrelevance.v | 12 ++ test-suite/failure/universes-buraliforti-redef.v | 246 ----------------------- test-suite/failure/universes-buraliforti.v | 237 ---------------------- test-suite/failure/universes-sections1.v | 8 - test-suite/failure/universes-sections2.v | 10 - test-suite/failure/universes_buraliforti.v | 237 ++++++++++++++++++++++ test-suite/failure/universes_buraliforti_redef.v | 246 +++++++++++++++++++++++ test-suite/failure/universes_sections1.v | 8 + test-suite/failure/universes_sections2.v | 10 + test-suite/output/rewrite-2172.out | 2 - test-suite/output/rewrite-2172.v | 21 -- test-suite/output/rewrite_2172.out | 2 + test-suite/output/rewrite_2172.v | 21 ++ test-suite/success/Cases-bug1834.v | 13 -- test-suite/success/Cases-bug3758.v | 17 -- test-suite/success/Cases_bug1834.v | 12 ++ test-suite/success/Cases_bug3758.v | 17 ++ test-suite/success/all-check.v | 3 - test-suite/success/all_check.v | 3 + test-suite/success/attribute-syntax.v | 33 --- test-suite/success/attribute_syntax.v | 33 +++ test-suite/success/dtauto-let-deps.v | 24 --- test-suite/success/dtauto_let_deps.v | 24 +++ test-suite/success/universes-coercion.v | 22 -- test-suite/success/universes_coercion.v | 22 ++ 28 files changed, 690 insertions(+), 691 deletions(-) delete mode 100644 test-suite/failure/guard-cofix.v create mode 100644 test-suite/failure/guard_cofix.v delete mode 100644 test-suite/failure/prop-set-proof-irrelevance.v create mode 100644 test-suite/failure/prop_set_proof_irrelevance.v delete mode 100644 test-suite/failure/universes-buraliforti-redef.v delete mode 100644 test-suite/failure/universes-buraliforti.v delete mode 100644 test-suite/failure/universes-sections1.v delete mode 100644 test-suite/failure/universes-sections2.v create mode 100644 test-suite/failure/universes_buraliforti.v create mode 100644 test-suite/failure/universes_buraliforti_redef.v create mode 100644 test-suite/failure/universes_sections1.v create mode 100644 test-suite/failure/universes_sections2.v delete mode 100644 test-suite/output/rewrite-2172.out delete mode 100644 test-suite/output/rewrite-2172.v create mode 100644 test-suite/output/rewrite_2172.out create mode 100644 test-suite/output/rewrite_2172.v delete mode 100644 test-suite/success/Cases-bug1834.v delete mode 100644 test-suite/success/Cases-bug3758.v create mode 100644 test-suite/success/Cases_bug1834.v create mode 100644 test-suite/success/Cases_bug3758.v delete mode 100644 test-suite/success/all-check.v create mode 100644 test-suite/success/all_check.v delete mode 100644 test-suite/success/attribute-syntax.v create mode 100644 test-suite/success/attribute_syntax.v delete mode 100644 test-suite/success/dtauto-let-deps.v create mode 100644 test-suite/success/dtauto_let_deps.v delete mode 100644 test-suite/success/universes-coercion.v create mode 100644 test-suite/success/universes_coercion.v diff --git a/test-suite/failure/guard-cofix.v b/test-suite/failure/guard-cofix.v deleted file mode 100644 index 3ae8770546..0000000000 --- a/test-suite/failure/guard-cofix.v +++ /dev/null @@ -1,43 +0,0 @@ -(* This script shows, in two different ways, the inconsistency of the -propositional extensionality axiom with the guard condition for cofixpoints. It -is the dual of the problem on fixpoints (cf subterm.v, subterm2.v, -subterm3.v). Posted on Coq-club by Maxime Dénès (02/26/2014). *) - -(* First example *) - -CoInductive CoFalse : Prop := CF : CoFalse -> False -> CoFalse. - -CoInductive Pandora : Prop := C : CoFalse -> Pandora. - -Axiom prop_ext : forall P Q : Prop, (P<->Q) -> P = Q. - -Lemma foo : Pandora = CoFalse. -apply prop_ext. -constructor. -intro x; destruct x; assumption. -exact C. -Qed. - -Fail CoFixpoint loop : CoFalse := -match foo in (_ = T) return T with eq_refl => C loop end. - -Fail Definition ff : False := match loop with CF _ t => t end. - -(* Second example *) - -Inductive omega : Prop := Omega : omega -> omega. - -Lemma H : omega = CoFalse. -Proof. -apply prop_ext; constructor. - induction 1; assumption. -destruct 1; destruct H0. -Qed. - -Fail CoFixpoint loop' : CoFalse := - match H in _ = T return T with - eq_refl => - Omega match eq_sym H in _ = T return T with eq_refl => loop' end - end. - -Fail Definition ff' : False := match loop' with CF _ t => t end. diff --git a/test-suite/failure/guard_cofix.v b/test-suite/failure/guard_cofix.v new file mode 100644 index 0000000000..3ae8770546 --- /dev/null +++ b/test-suite/failure/guard_cofix.v @@ -0,0 +1,43 @@ +(* This script shows, in two different ways, the inconsistency of the +propositional extensionality axiom with the guard condition for cofixpoints. It +is the dual of the problem on fixpoints (cf subterm.v, subterm2.v, +subterm3.v). Posted on Coq-club by Maxime Dénès (02/26/2014). *) + +(* First example *) + +CoInductive CoFalse : Prop := CF : CoFalse -> False -> CoFalse. + +CoInductive Pandora : Prop := C : CoFalse -> Pandora. + +Axiom prop_ext : forall P Q : Prop, (P<->Q) -> P = Q. + +Lemma foo : Pandora = CoFalse. +apply prop_ext. +constructor. +intro x; destruct x; assumption. +exact C. +Qed. + +Fail CoFixpoint loop : CoFalse := +match foo in (_ = T) return T with eq_refl => C loop end. + +Fail Definition ff : False := match loop with CF _ t => t end. + +(* Second example *) + +Inductive omega : Prop := Omega : omega -> omega. + +Lemma H : omega = CoFalse. +Proof. +apply prop_ext; constructor. + induction 1; assumption. +destruct 1; destruct H0. +Qed. + +Fail CoFixpoint loop' : CoFalse := + match H in _ = T return T with + eq_refl => + Omega match eq_sym H in _ = T return T with eq_refl => loop' end + end. + +Fail Definition ff' : False := match loop' with CF _ t => t end. diff --git a/test-suite/failure/prop-set-proof-irrelevance.v b/test-suite/failure/prop-set-proof-irrelevance.v deleted file mode 100644 index fee33432b0..0000000000 --- a/test-suite/failure/prop-set-proof-irrelevance.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import ProofIrrelevance. - -Lemma proof_irrelevance_set : forall (P : Set) (p1 p2 : P), p1 = p2. - Fail exact proof_irrelevance. -(*Qed. - -Lemma paradox : False. - assert (H : 0 <> 1) by discriminate. - apply H. - Fail apply proof_irrelevance. (* inlined version is rejected *) - apply proof_irrelevance_set. -Qed.*) diff --git a/test-suite/failure/prop_set_proof_irrelevance.v b/test-suite/failure/prop_set_proof_irrelevance.v new file mode 100644 index 0000000000..fee33432b0 --- /dev/null +++ b/test-suite/failure/prop_set_proof_irrelevance.v @@ -0,0 +1,12 @@ +Require Import ProofIrrelevance. + +Lemma proof_irrelevance_set : forall (P : Set) (p1 p2 : P), p1 = p2. + Fail exact proof_irrelevance. +(*Qed. + +Lemma paradox : False. + assert (H : 0 <> 1) by discriminate. + apply H. + Fail apply proof_irrelevance. (* inlined version is rejected *) + apply proof_irrelevance_set. +Qed.*) diff --git a/test-suite/failure/universes-buraliforti-redef.v b/test-suite/failure/universes-buraliforti-redef.v deleted file mode 100644 index e016815880..0000000000 --- a/test-suite/failure/universes-buraliforti-redef.v +++ /dev/null @@ -1,246 +0,0 @@ -(* A variant of Burali-Forti that used to pass in V8.1beta, because of - a bug in the instantiation of sort-polymorphic inductive types *) - -(* The following type seems to satisfy the hypothesis of the paradox below *) -(* It should infer constraints forbidding the paradox to go through, but via *) -(* a redefinition that did not propagate constraints correctly in V8.1beta *) -(* it was exploitable to derive an inconsistency *) - -(* We keep the file as a non regression test of the bug *) - - Record A1 (B:Type) (g:B->Type) : Type := (* Type_i' *) - i1 {X0 : B; R0 : g X0 -> g X0 -> Prop}. (* X0: Type_j' *) - - Definition A2 := A1. (* here was the bug *) - - Definition A0 := (A2 Type (fun x => x)). - Definition i0 := (i1 Type (fun x => x)). - -(* The rest is as in universes-buraliforti.v *) - - -(* Some properties about relations on objects in Type *) - - Inductive ACC (A : Type) (R : A -> A -> Prop) : A -> Prop := - ACC_intro : - forall x : A, (forall y : A, R y x -> ACC A R y) -> ACC A R x. - - Lemma ACC_nonreflexive : - forall (A : Type) (R : A -> A -> Prop) (x : A), - ACC A R x -> R x x -> False. -simple induction 1; intros. -exact (H1 x0 H2 H2). -Qed. - - Definition WF (A : Type) (R : A -> A -> Prop) := forall x : A, ACC A R x. - - -Section Inverse_Image. - - Variables (A B : Type) (R : B -> B -> Prop) (f : A -> B). - - Definition Rof (x y : A) : Prop := R (f x) (f y). - - Remark ACC_lemma : - forall y : B, ACC B R y -> forall x : A, y = f x -> ACC A Rof x. - simple induction 1; intros. - constructor; intros. - apply (H1 (f y0)); trivial. - elim H2 using eq_ind_r; trivial. - Qed. - - Lemma ACC_inverse_image : forall x : A, ACC B R (f x) -> ACC A Rof x. - intros; apply (ACC_lemma (f x)); trivial. - Qed. - - Lemma WF_inverse_image : WF B R -> WF A Rof. - red; intros; apply ACC_inverse_image; auto. - Qed. - -End Inverse_Image. - - -(* Remark: the paradox is written in Type, but also works in Prop or Set. *) - -Section Burali_Forti_Paradox. - - Definition morphism (A : Type) (R : A -> A -> Prop) - (B : Type) (S : B -> B -> Prop) (f : A -> B) := - forall x y : A, R x y -> S (f x) (f y). - - (* The hypothesis of the paradox: - assumes there exists an universal system of notations, i.e: - - A type A0 - - An injection i0 from relations on any type into A0 - - The proof that i0 is injective modulo morphism - *) - Variable A0 : Type. (* Type_i *) - Variable i0 : forall X : Type, (X -> X -> Prop) -> A0. (* X: Type_j *) - Hypothesis - inj : - forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type) - (R2 : X2 -> X2 -> Prop), - i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f. - - (* Embedding of x in y: x and y are images of 2 well founded relations - R1 and R2, the ordinal of R2 being strictly greater than that of R1. - *) - Record emb (x y : A0) : Prop := - {X1 : Type; - R1 : X1 -> X1 -> Prop; - eqx : x = i0 X1 R1; - X2 : Type; - R2 : X2 -> X2 -> Prop; - eqy : y = i0 X2 R2; - W2 : WF X2 R2; - f : X1 -> X2; - fmorph : morphism X1 R1 X2 R2 f; - maj : X2; - majf : forall z : X1, R2 (f z) maj}. - - Lemma emb_trans : forall x y z : A0, emb x y -> emb y z -> emb x z. -intros. -case H; intros X1 R1 eqx X2 R2 eqy; intros. -case H0; intros X3 R3 eqx0 X4 R4 eqy0; intros. -generalize eqx0; clear eqx0. -elim eqy using eq_ind_r; intro. -case (inj _ _ _ _ eqx0); intros. -exists X1 R1 X4 R4 (fun x : X1 => f0 (x0 (f x))) maj0; trivial. -red; auto. -Defined. - - - Lemma ACC_emb : - forall (X : Type) (R : X -> X -> Prop) (x : X), - ACC X R x -> - forall (Y : Type) (S : Y -> Y -> Prop) (f : Y -> X), - morphism Y S X R f -> (forall y : Y, R (f y) x) -> ACC A0 emb (i0 Y S). -simple induction 1; intros. -constructor; intros. -case H4; intros. -elim eqx using eq_ind_r. -case (inj X2 R2 Y S). -apply sym_eq; assumption. - -intros. -apply H1 with (y := f (x1 maj)) (f := fun x : X1 => f (x1 (f0 x))); - try red; auto. -Defined. - - (* The embedding relation is well founded *) - Lemma WF_emb : WF A0 emb. -constructor; intros. -case H; intros. -elim eqx using eq_ind_r. -apply ACC_emb with (X := X2) (R := R2) (x := maj) (f := f); trivial. -Defined. - - - (* The following definition enforces Type_j >= Type_i *) - Definition Omega : A0 := i0 A0 emb. - - -Section Subsets. - - Variable a : A0. - - (* We define the type of elements of A0 smaller than a w.r.t embedding. - The Record is in Type, but it is possible to avoid such structure. *) - Record sub : Type := {witness : A0; emb_wit : emb witness a}. - - (* F is its image through i0 *) - Definition F : A0 := i0 sub (Rof _ _ emb witness). - - (* F is embedded in Omega: - - the witness projection is a morphism - - a is an upper bound because emb_wit proves that witness is - smaller than a. - *) - Lemma F_emb_Omega : emb F Omega. -exists sub (Rof _ _ emb witness) A0 emb witness a; trivial. -exact WF_emb. - -red; trivial. - -exact emb_wit. -Defined. - -End Subsets. - - - Definition fsub (a b : A0) (H : emb a b) (x : sub a) : - sub b := Build_sub _ (witness _ x) (emb_trans _ _ _ (emb_wit _ x) H). - - (* F is a morphism: a < b => F(a) < F(b) - - the morphism from F(a) to F(b) is fsub above - - the upper bound is a, which is in F(b) since a < b - *) - Lemma F_morphism : morphism A0 emb A0 emb F. -red; intros. -exists - (sub x) - (Rof _ _ emb (witness x)) - (sub y) - (Rof _ _ emb (witness y)) - (fsub x y H) - (Build_sub _ x H); trivial. -apply WF_inverse_image. -exact WF_emb. - -unfold morphism, Rof, fsub; simpl; intros. -trivial. - -unfold Rof, fsub; simpl; intros. -apply emb_wit. -Defined. - - - (* Omega is embedded in itself: - - F is a morphism - - Omega is an upper bound of the image of F - *) - Lemma Omega_refl : emb Omega Omega. -exists A0 emb A0 emb F Omega; trivial. -exact WF_emb. - -exact F_morphism. - -exact F_emb_Omega. -Defined. - - (* The paradox is that Omega cannot be embedded in itself, since - the embedding relation is well founded. - *) - Theorem Burali_Forti : False. -apply ACC_nonreflexive with A0 emb Omega. -apply WF_emb. - -exact Omega_refl. - -Defined. - -End Burali_Forti_Paradox. - - - (* Note: this proof uses a large elimination of A0. *) - Lemma inj : - forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type) - (R2 : X2 -> X2 -> Prop), - i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f. -intros. -change - match i0 X1 R1, i0 X2 R2 with - | i1 _ _ x1 r1, i1 _ _ x2 r2 => exists f : _, morphism x1 r1 x2 r2 f - end. -case H; simpl. -exists (fun x : X1 => x). -red; trivial. -Defined. - -(* The following command should raise 'Error: Universe Inconsistency'. - To allow large elimination of A0, i0 must not be a large constructor. - Hence, the constraint Type_j' < Type_i' is added, which is incompatible - with the constraint j >= i in the paradox. -*) - - Fail Definition Paradox : False := Burali_Forti A0 i0 inj. diff --git a/test-suite/failure/universes-buraliforti.v b/test-suite/failure/universes-buraliforti.v deleted file mode 100644 index dba1a794fa..0000000000 --- a/test-suite/failure/universes-buraliforti.v +++ /dev/null @@ -1,237 +0,0 @@ -(* Check that Burali-Forti paradox does not go through *) - -(* Source: contrib/Rocq/PARADOX/{Logics,BuraliForti},v *) - -(* Some properties about relations on objects in Type *) - - Inductive ACC (A : Type) (R : A -> A -> Prop) : A -> Prop := - ACC_intro : - forall x : A, (forall y : A, R y x -> ACC A R y) -> ACC A R x. - - Lemma ACC_nonreflexive : - forall (A : Type) (R : A -> A -> Prop) (x : A), - ACC A R x -> R x x -> False. -simple induction 1; intros. -exact (H1 x0 H2 H2). -Qed. - - Definition WF (A : Type) (R : A -> A -> Prop) := forall x : A, ACC A R x. - - -Section Inverse_Image. - - Variables (A B : Type) (R : B -> B -> Prop) (f : A -> B). - - Definition Rof (x y : A) : Prop := R (f x) (f y). - - Remark ACC_lemma : - forall y : B, ACC B R y -> forall x : A, y = f x -> ACC A Rof x. - simple induction 1; intros. - constructor; intros. - apply (H1 (f y0)); trivial. - elim H2 using eq_ind_r; trivial. - Qed. - - Lemma ACC_inverse_image : forall x : A, ACC B R (f x) -> ACC A Rof x. - intros; apply (ACC_lemma (f x)); trivial. - Qed. - - Lemma WF_inverse_image : WF B R -> WF A Rof. - red; intros; apply ACC_inverse_image; auto. - Qed. - -End Inverse_Image. - - -(* Remark: the paradox is written in Type, but also works in Prop or Set. *) - -Section Burali_Forti_Paradox. - - Definition morphism (A : Type) (R : A -> A -> Prop) - (B : Type) (S : B -> B -> Prop) (f : A -> B) := - forall x y : A, R x y -> S (f x) (f y). - - (* The hypothesis of the paradox: - assumes there exists an universal system of notations, i.e: - - A type A0 - - An injection i0 from relations on any type into A0 - - The proof that i0 is injective modulo morphism - *) - Variable A0 : Type. (* Type_i *) - Variable i0 : forall X : Type, (X -> X -> Prop) -> A0. (* X: Type_j *) - Hypothesis - inj : - forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type) - (R2 : X2 -> X2 -> Prop), - i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f. - - (* Embedding of x in y: x and y are images of 2 well founded relations - R1 and R2, the ordinal of R2 being strictly greater than that of R1. - *) - Record emb (x y : A0) : Prop := - {X1 : Type; - R1 : X1 -> X1 -> Prop; - eqx : x = i0 X1 R1; - X2 : Type; - R2 : X2 -> X2 -> Prop; - eqy : y = i0 X2 R2; - W2 : WF X2 R2; - f : X1 -> X2; - fmorph : morphism X1 R1 X2 R2 f; - maj : X2; - majf : forall z : X1, R2 (f z) maj}. - - - Lemma emb_trans : forall x y z : A0, emb x y -> emb y z -> emb x z. -intros. -case H; intros. -case H0; intros. -generalize eqx0; clear eqx0. -elim eqy using eq_ind_r; intro. -case (inj _ _ _ _ eqx0); intros. -exists X1 R1 X3 R3 (fun x : X1 => f0 (x0 (f x))) maj0; trivial. -red; auto. -Defined. - - - Lemma ACC_emb : - forall (X : Type) (R : X -> X -> Prop) (x : X), - ACC X R x -> - forall (Y : Type) (S : Y -> Y -> Prop) (f : Y -> X), - morphism Y S X R f -> (forall y : Y, R (f y) x) -> ACC A0 emb (i0 Y S). -simple induction 1; intros. -constructor; intros. -case H4; intros. -elim eqx using eq_ind_r. -case (inj X2 R2 Y S). -apply sym_eq; assumption. - -intros. -apply H1 with (y := f (x1 maj)) (f := fun x : X1 => f (x1 (f0 x))); - try red; auto. -Defined. - - (* The embedding relation is well founded *) - Lemma WF_emb : WF A0 emb. -constructor; intros. -case H; intros. -elim eqx using eq_ind_r. -apply ACC_emb with (X := X2) (R := R2) (x := maj) (f := f); trivial. -Defined. - - - (* The following definition enforces Type_j >= Type_i *) - Definition Omega : A0 := i0 A0 emb. - - -Section Subsets. - - Variable a : A0. - - (* We define the type of elements of A0 smaller than a w.r.t embedding. - The Record is in Type, but it is possible to avoid such structure. *) - Record sub : Type := {witness : A0; emb_wit : emb witness a}. - - (* F is its image through i0 *) - Definition F : A0 := i0 sub (Rof _ _ emb witness). - - (* F is embedded in Omega: - - the witness projection is a morphism - - a is an upper bound because emb_wit proves that witness is - smaller than a. - *) - Lemma F_emb_Omega : emb F Omega. -exists sub (Rof _ _ emb witness) A0 emb witness a; trivial. -exact WF_emb. - -red; trivial. - -exact emb_wit. -Defined. - -End Subsets. - - - Definition fsub (a b : A0) (H : emb a b) (x : sub a) : - sub b := Build_sub _ (witness _ x) (emb_trans _ _ _ (emb_wit _ x) H). - - (* F is a morphism: a < b => F(a) < F(b) - - the morphism from F(a) to F(b) is fsub above - - the upper bound is a, which is in F(b) since a < b - *) - Lemma F_morphism : morphism A0 emb A0 emb F. -red; intros. -exists - (sub x) - (Rof _ _ emb (witness x)) - (sub y) - (Rof _ _ emb (witness y)) - (fsub x y H) - (Build_sub _ x H); trivial. -apply WF_inverse_image. -exact WF_emb. - -unfold morphism, Rof, fsub; simpl; intros. -trivial. - -unfold Rof, fsub; simpl; intros. -apply emb_wit. -Defined. - - - (* Omega is embedded in itself: - - F is a morphism - - Omega is an upper bound of the image of F - *) - Lemma Omega_refl : emb Omega Omega. -exists A0 emb A0 emb F Omega; trivial. -exact WF_emb. - -exact F_morphism. - -exact F_emb_Omega. -Defined. - - (* The paradox is that Omega cannot be embedded in itself, since - the embedding relation is well founded. - *) - Theorem Burali_Forti : False. -apply ACC_nonreflexive with A0 emb Omega. -apply WF_emb. - -exact Omega_refl. - -Defined. - -End Burali_Forti_Paradox. - - - (* The following type seems to satisfy the hypothesis of the paradox. - But it does not! - *) - Record A0 : Type := (* Type_i' *) - i0 {X0 : Type; R0 : X0 -> X0 -> Prop}. (* X0: Type_j' *) - - - (* Note: this proof uses a large elimination of A0. *) - Lemma inj : - forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type) - (R2 : X2 -> X2 -> Prop), - i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f. -intros. -change - match i0 X1 R1, i0 X2 R2 with - | i0 x1 r1, i0 x2 r2 => exists f : _, morphism x1 r1 x2 r2 f - end. -case H; simpl. -exists (fun x : X1 => x). -red; trivial. -Defined. - -(* The following command raises 'Error: Universe Inconsistency'. - To allow large elimination of A0, i0 must not be a large constructor. - Hence, the constraint Type_j' < Type_i' is added, which is incompatible - with the constraint j >= i in the paradox. -*) - - Fail Definition Paradox : False := Burali_Forti A0 i0 inj. diff --git a/test-suite/failure/universes-sections1.v b/test-suite/failure/universes-sections1.v deleted file mode 100644 index 3f8e444623..0000000000 --- a/test-suite/failure/universes-sections1.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Check that constraints on definitions are preserved by discharging *) - -Section A. - Definition Type2 := Type. - Definition Type1 : Type2 := Type. -End A. - -Fail Definition Inconsistency : Type1 := Type2. diff --git a/test-suite/failure/universes-sections2.v b/test-suite/failure/universes-sections2.v deleted file mode 100644 index 34b2a11ded..0000000000 --- a/test-suite/failure/universes-sections2.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Check that constraints on locals are preserved by discharging *) - -Definition Type2 := Type. - -Section A. - Let Type1 : Type2 := Type. - Definition Type1' := Type1. -End A. - -Fail Definition Inconsistency : Type1' := Type2. diff --git a/test-suite/failure/universes_buraliforti.v b/test-suite/failure/universes_buraliforti.v new file mode 100644 index 0000000000..dba1a794fa --- /dev/null +++ b/test-suite/failure/universes_buraliforti.v @@ -0,0 +1,237 @@ +(* Check that Burali-Forti paradox does not go through *) + +(* Source: contrib/Rocq/PARADOX/{Logics,BuraliForti},v *) + +(* Some properties about relations on objects in Type *) + + Inductive ACC (A : Type) (R : A -> A -> Prop) : A -> Prop := + ACC_intro : + forall x : A, (forall y : A, R y x -> ACC A R y) -> ACC A R x. + + Lemma ACC_nonreflexive : + forall (A : Type) (R : A -> A -> Prop) (x : A), + ACC A R x -> R x x -> False. +simple induction 1; intros. +exact (H1 x0 H2 H2). +Qed. + + Definition WF (A : Type) (R : A -> A -> Prop) := forall x : A, ACC A R x. + + +Section Inverse_Image. + + Variables (A B : Type) (R : B -> B -> Prop) (f : A -> B). + + Definition Rof (x y : A) : Prop := R (f x) (f y). + + Remark ACC_lemma : + forall y : B, ACC B R y -> forall x : A, y = f x -> ACC A Rof x. + simple induction 1; intros. + constructor; intros. + apply (H1 (f y0)); trivial. + elim H2 using eq_ind_r; trivial. + Qed. + + Lemma ACC_inverse_image : forall x : A, ACC B R (f x) -> ACC A Rof x. + intros; apply (ACC_lemma (f x)); trivial. + Qed. + + Lemma WF_inverse_image : WF B R -> WF A Rof. + red; intros; apply ACC_inverse_image; auto. + Qed. + +End Inverse_Image. + + +(* Remark: the paradox is written in Type, but also works in Prop or Set. *) + +Section Burali_Forti_Paradox. + + Definition morphism (A : Type) (R : A -> A -> Prop) + (B : Type) (S : B -> B -> Prop) (f : A -> B) := + forall x y : A, R x y -> S (f x) (f y). + + (* The hypothesis of the paradox: + assumes there exists an universal system of notations, i.e: + - A type A0 + - An injection i0 from relations on any type into A0 + - The proof that i0 is injective modulo morphism + *) + Variable A0 : Type. (* Type_i *) + Variable i0 : forall X : Type, (X -> X -> Prop) -> A0. (* X: Type_j *) + Hypothesis + inj : + forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type) + (R2 : X2 -> X2 -> Prop), + i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f. + + (* Embedding of x in y: x and y are images of 2 well founded relations + R1 and R2, the ordinal of R2 being strictly greater than that of R1. + *) + Record emb (x y : A0) : Prop := + {X1 : Type; + R1 : X1 -> X1 -> Prop; + eqx : x = i0 X1 R1; + X2 : Type; + R2 : X2 -> X2 -> Prop; + eqy : y = i0 X2 R2; + W2 : WF X2 R2; + f : X1 -> X2; + fmorph : morphism X1 R1 X2 R2 f; + maj : X2; + majf : forall z : X1, R2 (f z) maj}. + + + Lemma emb_trans : forall x y z : A0, emb x y -> emb y z -> emb x z. +intros. +case H; intros. +case H0; intros. +generalize eqx0; clear eqx0. +elim eqy using eq_ind_r; intro. +case (inj _ _ _ _ eqx0); intros. +exists X1 R1 X3 R3 (fun x : X1 => f0 (x0 (f x))) maj0; trivial. +red; auto. +Defined. + + + Lemma ACC_emb : + forall (X : Type) (R : X -> X -> Prop) (x : X), + ACC X R x -> + forall (Y : Type) (S : Y -> Y -> Prop) (f : Y -> X), + morphism Y S X R f -> (forall y : Y, R (f y) x) -> ACC A0 emb (i0 Y S). +simple induction 1; intros. +constructor; intros. +case H4; intros. +elim eqx using eq_ind_r. +case (inj X2 R2 Y S). +apply sym_eq; assumption. + +intros. +apply H1 with (y := f (x1 maj)) (f := fun x : X1 => f (x1 (f0 x))); + try red; auto. +Defined. + + (* The embedding relation is well founded *) + Lemma WF_emb : WF A0 emb. +constructor; intros. +case H; intros. +elim eqx using eq_ind_r. +apply ACC_emb with (X := X2) (R := R2) (x := maj) (f := f); trivial. +Defined. + + + (* The following definition enforces Type_j >= Type_i *) + Definition Omega : A0 := i0 A0 emb. + + +Section Subsets. + + Variable a : A0. + + (* We define the type of elements of A0 smaller than a w.r.t embedding. + The Record is in Type, but it is possible to avoid such structure. *) + Record sub : Type := {witness : A0; emb_wit : emb witness a}. + + (* F is its image through i0 *) + Definition F : A0 := i0 sub (Rof _ _ emb witness). + + (* F is embedded in Omega: + - the witness projection is a morphism + - a is an upper bound because emb_wit proves that witness is + smaller than a. + *) + Lemma F_emb_Omega : emb F Omega. +exists sub (Rof _ _ emb witness) A0 emb witness a; trivial. +exact WF_emb. + +red; trivial. + +exact emb_wit. +Defined. + +End Subsets. + + + Definition fsub (a b : A0) (H : emb a b) (x : sub a) : + sub b := Build_sub _ (witness _ x) (emb_trans _ _ _ (emb_wit _ x) H). + + (* F is a morphism: a < b => F(a) < F(b) + - the morphism from F(a) to F(b) is fsub above + - the upper bound is a, which is in F(b) since a < b + *) + Lemma F_morphism : morphism A0 emb A0 emb F. +red; intros. +exists + (sub x) + (Rof _ _ emb (witness x)) + (sub y) + (Rof _ _ emb (witness y)) + (fsub x y H) + (Build_sub _ x H); trivial. +apply WF_inverse_image. +exact WF_emb. + +unfold morphism, Rof, fsub; simpl; intros. +trivial. + +unfold Rof, fsub; simpl; intros. +apply emb_wit. +Defined. + + + (* Omega is embedded in itself: + - F is a morphism + - Omega is an upper bound of the image of F + *) + Lemma Omega_refl : emb Omega Omega. +exists A0 emb A0 emb F Omega; trivial. +exact WF_emb. + +exact F_morphism. + +exact F_emb_Omega. +Defined. + + (* The paradox is that Omega cannot be embedded in itself, since + the embedding relation is well founded. + *) + Theorem Burali_Forti : False. +apply ACC_nonreflexive with A0 emb Omega. +apply WF_emb. + +exact Omega_refl. + +Defined. + +End Burali_Forti_Paradox. + + + (* The following type seems to satisfy the hypothesis of the paradox. + But it does not! + *) + Record A0 : Type := (* Type_i' *) + i0 {X0 : Type; R0 : X0 -> X0 -> Prop}. (* X0: Type_j' *) + + + (* Note: this proof uses a large elimination of A0. *) + Lemma inj : + forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type) + (R2 : X2 -> X2 -> Prop), + i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f. +intros. +change + match i0 X1 R1, i0 X2 R2 with + | i0 x1 r1, i0 x2 r2 => exists f : _, morphism x1 r1 x2 r2 f + end. +case H; simpl. +exists (fun x : X1 => x). +red; trivial. +Defined. + +(* The following command raises 'Error: Universe Inconsistency'. + To allow large elimination of A0, i0 must not be a large constructor. + Hence, the constraint Type_j' < Type_i' is added, which is incompatible + with the constraint j >= i in the paradox. +*) + + Fail Definition Paradox : False := Burali_Forti A0 i0 inj. diff --git a/test-suite/failure/universes_buraliforti_redef.v b/test-suite/failure/universes_buraliforti_redef.v new file mode 100644 index 0000000000..e016815880 --- /dev/null +++ b/test-suite/failure/universes_buraliforti_redef.v @@ -0,0 +1,246 @@ +(* A variant of Burali-Forti that used to pass in V8.1beta, because of + a bug in the instantiation of sort-polymorphic inductive types *) + +(* The following type seems to satisfy the hypothesis of the paradox below *) +(* It should infer constraints forbidding the paradox to go through, but via *) +(* a redefinition that did not propagate constraints correctly in V8.1beta *) +(* it was exploitable to derive an inconsistency *) + +(* We keep the file as a non regression test of the bug *) + + Record A1 (B:Type) (g:B->Type) : Type := (* Type_i' *) + i1 {X0 : B; R0 : g X0 -> g X0 -> Prop}. (* X0: Type_j' *) + + Definition A2 := A1. (* here was the bug *) + + Definition A0 := (A2 Type (fun x => x)). + Definition i0 := (i1 Type (fun x => x)). + +(* The rest is as in universes-buraliforti.v *) + + +(* Some properties about relations on objects in Type *) + + Inductive ACC (A : Type) (R : A -> A -> Prop) : A -> Prop := + ACC_intro : + forall x : A, (forall y : A, R y x -> ACC A R y) -> ACC A R x. + + Lemma ACC_nonreflexive : + forall (A : Type) (R : A -> A -> Prop) (x : A), + ACC A R x -> R x x -> False. +simple induction 1; intros. +exact (H1 x0 H2 H2). +Qed. + + Definition WF (A : Type) (R : A -> A -> Prop) := forall x : A, ACC A R x. + + +Section Inverse_Image. + + Variables (A B : Type) (R : B -> B -> Prop) (f : A -> B). + + Definition Rof (x y : A) : Prop := R (f x) (f y). + + Remark ACC_lemma : + forall y : B, ACC B R y -> forall x : A, y = f x -> ACC A Rof x. + simple induction 1; intros. + constructor; intros. + apply (H1 (f y0)); trivial. + elim H2 using eq_ind_r; trivial. + Qed. + + Lemma ACC_inverse_image : forall x : A, ACC B R (f x) -> ACC A Rof x. + intros; apply (ACC_lemma (f x)); trivial. + Qed. + + Lemma WF_inverse_image : WF B R -> WF A Rof. + red; intros; apply ACC_inverse_image; auto. + Qed. + +End Inverse_Image. + + +(* Remark: the paradox is written in Type, but also works in Prop or Set. *) + +Section Burali_Forti_Paradox. + + Definition morphism (A : Type) (R : A -> A -> Prop) + (B : Type) (S : B -> B -> Prop) (f : A -> B) := + forall x y : A, R x y -> S (f x) (f y). + + (* The hypothesis of the paradox: + assumes there exists an universal system of notations, i.e: + - A type A0 + - An injection i0 from relations on any type into A0 + - The proof that i0 is injective modulo morphism + *) + Variable A0 : Type. (* Type_i *) + Variable i0 : forall X : Type, (X -> X -> Prop) -> A0. (* X: Type_j *) + Hypothesis + inj : + forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type) + (R2 : X2 -> X2 -> Prop), + i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f. + + (* Embedding of x in y: x and y are images of 2 well founded relations + R1 and R2, the ordinal of R2 being strictly greater than that of R1. + *) + Record emb (x y : A0) : Prop := + {X1 : Type; + R1 : X1 -> X1 -> Prop; + eqx : x = i0 X1 R1; + X2 : Type; + R2 : X2 -> X2 -> Prop; + eqy : y = i0 X2 R2; + W2 : WF X2 R2; + f : X1 -> X2; + fmorph : morphism X1 R1 X2 R2 f; + maj : X2; + majf : forall z : X1, R2 (f z) maj}. + + Lemma emb_trans : forall x y z : A0, emb x y -> emb y z -> emb x z. +intros. +case H; intros X1 R1 eqx X2 R2 eqy; intros. +case H0; intros X3 R3 eqx0 X4 R4 eqy0; intros. +generalize eqx0; clear eqx0. +elim eqy using eq_ind_r; intro. +case (inj _ _ _ _ eqx0); intros. +exists X1 R1 X4 R4 (fun x : X1 => f0 (x0 (f x))) maj0; trivial. +red; auto. +Defined. + + + Lemma ACC_emb : + forall (X : Type) (R : X -> X -> Prop) (x : X), + ACC X R x -> + forall (Y : Type) (S : Y -> Y -> Prop) (f : Y -> X), + morphism Y S X R f -> (forall y : Y, R (f y) x) -> ACC A0 emb (i0 Y S). +simple induction 1; intros. +constructor; intros. +case H4; intros. +elim eqx using eq_ind_r. +case (inj X2 R2 Y S). +apply sym_eq; assumption. + +intros. +apply H1 with (y := f (x1 maj)) (f := fun x : X1 => f (x1 (f0 x))); + try red; auto. +Defined. + + (* The embedding relation is well founded *) + Lemma WF_emb : WF A0 emb. +constructor; intros. +case H; intros. +elim eqx using eq_ind_r. +apply ACC_emb with (X := X2) (R := R2) (x := maj) (f := f); trivial. +Defined. + + + (* The following definition enforces Type_j >= Type_i *) + Definition Omega : A0 := i0 A0 emb. + + +Section Subsets. + + Variable a : A0. + + (* We define the type of elements of A0 smaller than a w.r.t embedding. + The Record is in Type, but it is possible to avoid such structure. *) + Record sub : Type := {witness : A0; emb_wit : emb witness a}. + + (* F is its image through i0 *) + Definition F : A0 := i0 sub (Rof _ _ emb witness). + + (* F is embedded in Omega: + - the witness projection is a morphism + - a is an upper bound because emb_wit proves that witness is + smaller than a. + *) + Lemma F_emb_Omega : emb F Omega. +exists sub (Rof _ _ emb witness) A0 emb witness a; trivial. +exact WF_emb. + +red; trivial. + +exact emb_wit. +Defined. + +End Subsets. + + + Definition fsub (a b : A0) (H : emb a b) (x : sub a) : + sub b := Build_sub _ (witness _ x) (emb_trans _ _ _ (emb_wit _ x) H). + + (* F is a morphism: a < b => F(a) < F(b) + - the morphism from F(a) to F(b) is fsub above + - the upper bound is a, which is in F(b) since a < b + *) + Lemma F_morphism : morphism A0 emb A0 emb F. +red; intros. +exists + (sub x) + (Rof _ _ emb (witness x)) + (sub y) + (Rof _ _ emb (witness y)) + (fsub x y H) + (Build_sub _ x H); trivial. +apply WF_inverse_image. +exact WF_emb. + +unfold morphism, Rof, fsub; simpl; intros. +trivial. + +unfold Rof, fsub; simpl; intros. +apply emb_wit. +Defined. + + + (* Omega is embedded in itself: + - F is a morphism + - Omega is an upper bound of the image of F + *) + Lemma Omega_refl : emb Omega Omega. +exists A0 emb A0 emb F Omega; trivial. +exact WF_emb. + +exact F_morphism. + +exact F_emb_Omega. +Defined. + + (* The paradox is that Omega cannot be embedded in itself, since + the embedding relation is well founded. + *) + Theorem Burali_Forti : False. +apply ACC_nonreflexive with A0 emb Omega. +apply WF_emb. + +exact Omega_refl. + +Defined. + +End Burali_Forti_Paradox. + + + (* Note: this proof uses a large elimination of A0. *) + Lemma inj : + forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type) + (R2 : X2 -> X2 -> Prop), + i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f. +intros. +change + match i0 X1 R1, i0 X2 R2 with + | i1 _ _ x1 r1, i1 _ _ x2 r2 => exists f : _, morphism x1 r1 x2 r2 f + end. +case H; simpl. +exists (fun x : X1 => x). +red; trivial. +Defined. + +(* The following command should raise 'Error: Universe Inconsistency'. + To allow large elimination of A0, i0 must not be a large constructor. + Hence, the constraint Type_j' < Type_i' is added, which is incompatible + with the constraint j >= i in the paradox. +*) + + Fail Definition Paradox : False := Burali_Forti A0 i0 inj. diff --git a/test-suite/failure/universes_sections1.v b/test-suite/failure/universes_sections1.v new file mode 100644 index 0000000000..3f8e444623 --- /dev/null +++ b/test-suite/failure/universes_sections1.v @@ -0,0 +1,8 @@ +(* Check that constraints on definitions are preserved by discharging *) + +Section A. + Definition Type2 := Type. + Definition Type1 : Type2 := Type. +End A. + +Fail Definition Inconsistency : Type1 := Type2. diff --git a/test-suite/failure/universes_sections2.v b/test-suite/failure/universes_sections2.v new file mode 100644 index 0000000000..34b2a11ded --- /dev/null +++ b/test-suite/failure/universes_sections2.v @@ -0,0 +1,10 @@ +(* Check that constraints on locals are preserved by discharging *) + +Definition Type2 := Type. + +Section A. + Let Type1 : Type2 := Type. + Definition Type1' := Type1. +End A. + +Fail Definition Inconsistency : Type1' := Type2. diff --git a/test-suite/output/rewrite-2172.out b/test-suite/output/rewrite-2172.out deleted file mode 100644 index 27b0dc1b7b..0000000000 --- a/test-suite/output/rewrite-2172.out +++ /dev/null @@ -1,2 +0,0 @@ -The command has indeed failed with message: -Unable to find an instance for the variable E. diff --git a/test-suite/output/rewrite-2172.v b/test-suite/output/rewrite-2172.v deleted file mode 100644 index 212b1c1259..0000000000 --- a/test-suite/output/rewrite-2172.v +++ /dev/null @@ -1,21 +0,0 @@ -(* This checks an error message as reported in bug #2172 *) - -Axiom axiom : forall (E F : nat), E = F. -Lemma test : forall (E F : nat), E = F. -Proof. - intros. -(* This used to raise the following non understandable error message: - - Error: Unable to find an instance for the variable x - - The reason this error was that rewrite generated the proof - - "eq_ind ?A ?x ?P ? ?y (axiom ?E ?F)" - - and the equation ?x=?E was solved in the way ?E:=?x leaving ?x - unresolved. A stupid hack for solve this consisted in ordering - meta=meta equations the other way round (with most recent evars - instantiated first - since they are assumed to come first from the - user in rewrite/induction/destruct calls). -*) - Fail rewrite <- axiom. diff --git a/test-suite/output/rewrite_2172.out b/test-suite/output/rewrite_2172.out new file mode 100644 index 0000000000..27b0dc1b7b --- /dev/null +++ b/test-suite/output/rewrite_2172.out @@ -0,0 +1,2 @@ +The command has indeed failed with message: +Unable to find an instance for the variable E. diff --git a/test-suite/output/rewrite_2172.v b/test-suite/output/rewrite_2172.v new file mode 100644 index 0000000000..212b1c1259 --- /dev/null +++ b/test-suite/output/rewrite_2172.v @@ -0,0 +1,21 @@ +(* This checks an error message as reported in bug #2172 *) + +Axiom axiom : forall (E F : nat), E = F. +Lemma test : forall (E F : nat), E = F. +Proof. + intros. +(* This used to raise the following non understandable error message: + + Error: Unable to find an instance for the variable x + + The reason this error was that rewrite generated the proof + + "eq_ind ?A ?x ?P ? ?y (axiom ?E ?F)" + + and the equation ?x=?E was solved in the way ?E:=?x leaving ?x + unresolved. A stupid hack for solve this consisted in ordering + meta=meta equations the other way round (with most recent evars + instantiated first - since they are assumed to come first from the + user in rewrite/induction/destruct calls). +*) + Fail rewrite <- axiom. diff --git a/test-suite/success/Cases-bug1834.v b/test-suite/success/Cases-bug1834.v deleted file mode 100644 index cf102486a6..0000000000 --- a/test-suite/success/Cases-bug1834.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Bug in the computation of generalization *) - -(* The following bug, elaborated by Bruno Barras, is solved from r11083 *) - -Parameter P : unit -> Prop. -Definition T := sig P. -Parameter Q : T -> Prop. -Definition U := sig Q. -Parameter a : U. -Check (match a with exist _ (exist _ tt e2) e3 => e3=e3 end). - -(* There is still a form submitted by Pierre Corbineau (#1834) which fails *) - diff --git a/test-suite/success/Cases-bug3758.v b/test-suite/success/Cases-bug3758.v deleted file mode 100644 index e48f452326..0000000000 --- a/test-suite/success/Cases-bug3758.v +++ /dev/null @@ -1,17 +0,0 @@ -(* There used to be an evar leak in the to_nat example *) - -Require Import Coq.Lists.List. -Import ListNotations. - -Fixpoint Idx {A:Type} (l:list A) : Type := - match l with - | [] => False - | _::l => True + Idx l - end. - -Fixpoint to_nat {A:Type} (l:list A) (i:Idx l) : nat := - match l,i with - | [] , i => match i with end - | _::_, inl _ => 0 - | _::l, inr i => S (to_nat l i) - end. diff --git a/test-suite/success/Cases_bug1834.v b/test-suite/success/Cases_bug1834.v new file mode 100644 index 0000000000..65372c2da4 --- /dev/null +++ b/test-suite/success/Cases_bug1834.v @@ -0,0 +1,12 @@ +(* Bug in the computation of generalization *) + +(* The following bug, elaborated by Bruno Barras, is solved from r11083 *) + +Parameter P : unit -> Prop. +Definition T := sig P. +Parameter Q : T -> Prop. +Definition U := sig Q. +Parameter a : U. +Check (match a with exist _ (exist _ tt e2) e3 => e3=e3 end). + +(* There is still a form submitted by Pierre Corbineau (#1834) which fails *) diff --git a/test-suite/success/Cases_bug3758.v b/test-suite/success/Cases_bug3758.v new file mode 100644 index 0000000000..e48f452326 --- /dev/null +++ b/test-suite/success/Cases_bug3758.v @@ -0,0 +1,17 @@ +(* There used to be an evar leak in the to_nat example *) + +Require Import Coq.Lists.List. +Import ListNotations. + +Fixpoint Idx {A:Type} (l:list A) : Type := + match l with + | [] => False + | _::l => True + Idx l + end. + +Fixpoint to_nat {A:Type} (l:list A) (i:Idx l) : nat := + match l,i with + | [] , i => match i with end + | _::_, inl _ => 0 + | _::l, inr i => S (to_nat l i) + end. diff --git a/test-suite/success/all-check.v b/test-suite/success/all-check.v deleted file mode 100644 index 391bc540e4..0000000000 --- a/test-suite/success/all-check.v +++ /dev/null @@ -1,3 +0,0 @@ -Goal True. -Fail all:Check _. -Abort. diff --git a/test-suite/success/all_check.v b/test-suite/success/all_check.v new file mode 100644 index 0000000000..391bc540e4 --- /dev/null +++ b/test-suite/success/all_check.v @@ -0,0 +1,3 @@ +Goal True. +Fail all:Check _. +Abort. diff --git a/test-suite/success/attribute-syntax.v b/test-suite/success/attribute-syntax.v deleted file mode 100644 index 241d4eb200..0000000000 --- a/test-suite/success/attribute-syntax.v +++ /dev/null @@ -1,33 +0,0 @@ -From Coq Require Program.Wf. - -Section Scope. - -#[local] Coercion nat_of_bool (b: bool) : nat := - if b then 0 else 1. - -Check (refl_equal : true = 0 :> nat). - -End Scope. - -Fail Check 0 = true :> nat. - -#[polymorphic] -Definition ι T (x: T) := x. - -Check ι _ ι. - -#[program] -Fixpoint f (n: nat) {wf lt n} : nat := _. - -#[deprecated(since="8.9.0")] -Ltac foo := foo. - -Module M. - #[local] #[polymorphic] Definition zed := Type. - - #[local, polymorphic] Definition kats := Type. -End M. -Check M.zed@{_}. -Fail Check zed. -Check M.kats@{_}. -Fail Check kats. diff --git a/test-suite/success/attribute_syntax.v b/test-suite/success/attribute_syntax.v new file mode 100644 index 0000000000..241d4eb200 --- /dev/null +++ b/test-suite/success/attribute_syntax.v @@ -0,0 +1,33 @@ +From Coq Require Program.Wf. + +Section Scope. + +#[local] Coercion nat_of_bool (b: bool) : nat := + if b then 0 else 1. + +Check (refl_equal : true = 0 :> nat). + +End Scope. + +Fail Check 0 = true :> nat. + +#[polymorphic] +Definition ι T (x: T) := x. + +Check ι _ ι. + +#[program] +Fixpoint f (n: nat) {wf lt n} : nat := _. + +#[deprecated(since="8.9.0")] +Ltac foo := foo. + +Module M. + #[local] #[polymorphic] Definition zed := Type. + + #[local, polymorphic] Definition kats := Type. +End M. +Check M.zed@{_}. +Fail Check zed. +Check M.kats@{_}. +Fail Check kats. diff --git a/test-suite/success/dtauto-let-deps.v b/test-suite/success/dtauto-let-deps.v deleted file mode 100644 index 094b2f8b3c..0000000000 --- a/test-suite/success/dtauto-let-deps.v +++ /dev/null @@ -1,24 +0,0 @@ -(* -This test is sensitive to changes in which let-ins are expanded when checking -for dependencies in constructors. -If the (x := X) is not reduced, Foo1 won't be recognized as a conjunction, -and if the (y := X) is reduced, Foo2 will be recognized as a conjunction. - -This tests the behavior of engine/termops.ml : prod_applist_assum, -which is currently specified to reduce exactly the parameters. - -If dtauto is changed to reduce lets in constructors before checking dependency, -this test will need to be changed. -*) - -Context (P Q : Type). -Inductive Foo1 (X : Type) (x := X) := foo1 : let y := X in P -> Q -> Foo1 x. -Inductive Foo2 (X : Type) (x := X) := foo2 : let y := X in P -> Q -> Foo2 y. - -Goal P -> Q -> Foo1 nat. -solve [dtauto]. -Qed. - -Goal P -> Q -> Foo2 nat. -Fail solve [dtauto]. -Abort. diff --git a/test-suite/success/dtauto_let_deps.v b/test-suite/success/dtauto_let_deps.v new file mode 100644 index 0000000000..094b2f8b3c --- /dev/null +++ b/test-suite/success/dtauto_let_deps.v @@ -0,0 +1,24 @@ +(* +This test is sensitive to changes in which let-ins are expanded when checking +for dependencies in constructors. +If the (x := X) is not reduced, Foo1 won't be recognized as a conjunction, +and if the (y := X) is reduced, Foo2 will be recognized as a conjunction. + +This tests the behavior of engine/termops.ml : prod_applist_assum, +which is currently specified to reduce exactly the parameters. + +If dtauto is changed to reduce lets in constructors before checking dependency, +this test will need to be changed. +*) + +Context (P Q : Type). +Inductive Foo1 (X : Type) (x := X) := foo1 : let y := X in P -> Q -> Foo1 x. +Inductive Foo2 (X : Type) (x := X) := foo2 : let y := X in P -> Q -> Foo2 y. + +Goal P -> Q -> Foo1 nat. +solve [dtauto]. +Qed. + +Goal P -> Q -> Foo2 nat. +Fail solve [dtauto]. +Abort. diff --git a/test-suite/success/universes-coercion.v b/test-suite/success/universes-coercion.v deleted file mode 100644 index d750434027..0000000000 --- a/test-suite/success/universes-coercion.v +++ /dev/null @@ -1,22 +0,0 @@ -(* This example used to emphasize the absence of LEGO-style universe - polymorphism; Matthieu's improvements of typing on 2011/3/11 now - makes (apparently) that Amokrane's automatic eta-expansion in the - coercion mechanism works; this makes its illustration as a "weakness" - of universe polymorphism obsolete (example submitted by Randy Pollack). - - Note that this example is not an evidence that the current - non-kernel eta-expansion behavior is the most expected one. -*) - -Parameter K : forall T : Type, T -> T. -Check (K (forall T : Type, T -> T) K). - -(* - note that the inferred term is - "(K (forall T (* u1 *) : Type, T -> T) (fun T:Type (* u1 *) => K T))" - which is not eta-equivalent to - "(K (forall T : Type, T -> T) K" - because the eta-expansion of the latter - "(K (forall T : Type, T -> T) (fun T:Type (* u2 *) => K T)" - assuming K of type "forall T (* u2 *) : Type, T -> T" -*) diff --git a/test-suite/success/universes_coercion.v b/test-suite/success/universes_coercion.v new file mode 100644 index 0000000000..272d3ec74a --- /dev/null +++ b/test-suite/success/universes_coercion.v @@ -0,0 +1,22 @@ +(* This example used to emphasize the absence of LEGO-style universe + polymorphism; Matthieu's improvements of typing on 2011/3/11 now + makes (apparently) that Amokrane's automatic eta-expansion in the + coercion mechanism works; this makes its illustration as a "weakness" + of universe polymorphism obsolete (example submitted by Randy Pollack). + + Note that this example is not an evidence that the current + non-kernel eta-expansion behavior is the most expected one. +*) + +Parameter K : forall T : Type, T -> T. +Check (K (forall T : Type, T -> T) K). + +(* + note that the inferred term is + "(K (forall T (* u1 *) : Type, T -> T) (fun T:Type (* u1 *) => K T))" + which is not eta-equivalent to + "(K (forall T : Type, T -> T) K" + because the eta-expansion of the latter + "(K (forall T : Type, T -> T) (fun T:Type (* u2 *) => K T)" + assuming K of type "forall T (* u2 *) : Type, T -> T" +*) -- cgit v1.2.3 From 1e4ac27962aaab5132c9294156ac2a0da9652a43 Mon Sep 17 00:00:00 2001 From: Vincent Laporte Date: Tue, 2 Oct 2018 14:06:10 +0000 Subject: test-suite: cleaning --- test-suite/Makefile | 3 +- test-suite/bugs/closed/HoTT_coq_002.v | 1 + test-suite/bugs/closed/HoTT_coq_014.v | 1 + test-suite/bugs/closed/HoTT_coq_028.v | 1 + test-suite/bugs/closed/HoTT_coq_042.v | 1 + test-suite/bugs/closed/HoTT_coq_044.v | 1 + test-suite/bugs/closed/HoTT_coq_047.v | 1 + test-suite/bugs/closed/HoTT_coq_049.v | 1 + test-suite/bugs/closed/HoTT_coq_057.v | 1 + test-suite/bugs/closed/HoTT_coq_058.v | 1 + test-suite/bugs/closed/HoTT_coq_059.v | 1 + test-suite/bugs/closed/HoTT_coq_079.v | 1 + test-suite/bugs/closed/HoTT_coq_083.v | 1 + test-suite/bugs/closed/HoTT_coq_099.v | 1 + test-suite/bugs/closed/HoTT_coq_100.v | 1 + test-suite/bugs/closed/HoTT_coq_101.v | 1 + test-suite/bugs/closed/HoTT_coq_112.v | 1 + test-suite/bugs/closed/HoTT_coq_118.v | 1 + test-suite/bugs/closed/HoTT_coq_120.v | 2 ++ test-suite/bugs/closed/HoTT_coq_123.v | 1 + test-suite/bugs/closed/bug_1341.v | 2 ++ test-suite/bugs/closed/bug_1414.v | 1 + test-suite/bugs/closed/bug_1416.v | 1 + test-suite/bugs/closed/bug_1501.v | 2 ++ test-suite/bugs/closed/bug_1542.v | 2 ++ test-suite/bugs/closed/bug_1545.v | 2 ++ test-suite/bugs/closed/bug_1683.v | 2 ++ test-suite/bugs/closed/bug_1773.v | 1 + test-suite/bugs/closed/bug_1865.v | 1 + test-suite/bugs/closed/bug_1918.v | 1 + test-suite/bugs/closed/bug_1944.v | 1 + test-suite/bugs/closed/bug_1963.v | 1 + test-suite/bugs/closed/bug_2016.v | 1 + test-suite/bugs/closed/bug_2117.v | 1 + test-suite/bugs/closed/bug_2123.v | 1 + test-suite/bugs/closed/bug_2139.v | 1 + test-suite/bugs/closed/bug_2164.v | 1 + test-suite/bugs/closed/bug_2243.v | 2 ++ test-suite/bugs/closed/bug_2244.v | 1 + test-suite/bugs/closed/bug_2255.v | 1 + test-suite/bugs/closed/bug_2295.v | 2 ++ test-suite/bugs/closed/bug_2299.v | 3 ++ test-suite/bugs/closed/bug_2320.v | 1 + test-suite/bugs/closed/bug_2350.v | 1 + test-suite/bugs/closed/bug_2360.v | 1 + test-suite/bugs/closed/bug_2378.v | 3 ++ test-suite/bugs/closed/bug_2404.v | 2 ++ test-suite/bugs/closed/bug_2602.v | 1 + test-suite/bugs/closed/bug_2616.v | 1 + test-suite/bugs/closed/bug_2729.v | 1 + test-suite/bugs/closed/bug_2817.v | 1 + test-suite/bugs/closed/bug_2828.v | 1 + test-suite/bugs/closed/bug_2834.v | 1 + test-suite/bugs/closed/bug_2836.v | 2 ++ test-suite/bugs/closed/bug_2837.v | 1 + test-suite/bugs/closed/bug_2839.v | 1 + test-suite/bugs/closed/bug_2854.v | 2 ++ test-suite/bugs/closed/bug_2883.v | 2 ++ test-suite/bugs/closed/bug_2900.v | 1 + test-suite/bugs/closed/bug_2946.v | 2 ++ test-suite/bugs/closed/bug_2995.v | 4 +++ test-suite/bugs/closed/bug_2996.v | 2 ++ test-suite/bugs/closed/bug_3003.v | 1 + test-suite/bugs/closed/bug_3016.v | 2 ++ test-suite/bugs/closed/bug_3036.v | 2 ++ test-suite/bugs/closed/bug_3037.v | 1 + test-suite/bugs/closed/bug_3045.v | 1 + test-suite/bugs/closed/bug_3068.v | 3 ++ test-suite/bugs/closed/bug_3070.v | 1 + test-suite/bugs/closed/bug_3100.v | 1 + test-suite/bugs/closed/bug_3199.v | 1 + test-suite/bugs/closed/bug_3210.v | 1 + test-suite/bugs/closed/bug_3228.v | 1 + test-suite/bugs/closed/bug_3251.v | 1 + test-suite/bugs/closed/bug_3257.v | 1 + test-suite/bugs/closed/bug_3258.v | 1 + test-suite/bugs/closed/bug_3260.v | 1 + test-suite/bugs/closed/bug_3262.v | 2 ++ test-suite/bugs/closed/bug_3284.v | 1 + test-suite/bugs/closed/bug_3286.v | 1 + test-suite/bugs/closed/bug_3291.v | 1 + test-suite/bugs/closed/bug_3297.v | 1 + test-suite/bugs/closed/bug_3310.v | 1 + test-suite/bugs/closed/bug_3319.v | 1 + test-suite/bugs/closed/bug_3320.v | 1 + test-suite/bugs/closed/bug_3321.v | 1 + test-suite/bugs/closed/bug_3322.v | 2 ++ test-suite/bugs/closed/bug_3323.v | 1 + test-suite/bugs/closed/bug_3326.v | 1 + test-suite/bugs/closed/bug_3331.v | 1 + test-suite/bugs/closed/bug_3337.v | 1 + test-suite/bugs/closed/bug_3338.v | 1 + test-suite/bugs/closed/bug_3372.v | 1 + test-suite/bugs/closed/bug_3383.v | 1 + test-suite/bugs/closed/bug_3386.v | 1 + test-suite/bugs/closed/bug_3390.v | 1 + test-suite/bugs/closed/bug_3393.v | 2 ++ test-suite/bugs/closed/bug_3427.v | 2 ++ test-suite/bugs/closed/bug_3441.v | 1 + test-suite/bugs/closed/bug_3461.v | 1 + test-suite/bugs/closed/bug_3469.v | 1 + test-suite/bugs/closed/bug_3477.v | 1 + test-suite/bugs/closed/bug_3480.v | 2 ++ test-suite/bugs/closed/bug_3495.v | 1 + test-suite/bugs/closed/bug_3513.v | 1 + test-suite/bugs/closed/bug_3539.v | 1 + test-suite/bugs/closed/bug_3542.v | 2 ++ test-suite/bugs/closed/bug_3546.v | 1 + test-suite/bugs/closed/bug_3554.v | 1 + test-suite/bugs/closed/bug_3561.v | 1 + test-suite/bugs/closed/bug_3562.v | 1 + test-suite/bugs/closed/bug_3563.v | 1 + test-suite/bugs/closed/bug_3566.v | 1 + test-suite/bugs/closed/bug_3567.v | 1 + test-suite/bugs/closed/bug_3612.v | 1 + test-suite/bugs/closed/bug_3616.v | 1 + test-suite/bugs/closed/bug_3638.v | 1 + test-suite/bugs/closed/bug_3640.v | 1 + test-suite/bugs/closed/bug_3641.v | 1 + test-suite/bugs/closed/bug_3647.v | 1 + test-suite/bugs/closed/bug_3648.v | 1 + test-suite/bugs/closed/bug_3649.v | 1 + test-suite/bugs/closed/bug_3656.v | 1 + test-suite/bugs/closed/bug_3657.v | 1 + test-suite/bugs/closed/bug_3660.v | 1 + test-suite/bugs/closed/bug_3661.v | 1 + test-suite/bugs/closed/bug_3667.v | 1 + test-suite/bugs/closed/bug_3670.v | 1 + test-suite/bugs/closed/bug_3675.v | 1 + test-suite/bugs/closed/bug_3685.v | 1 + test-suite/bugs/closed/bug_3698.v | 1 + test-suite/bugs/closed/bug_3709.v | 2 ++ test-suite/bugs/closed/bug_3710.v | 1 + test-suite/bugs/closed/bug_3755.v | 1 + test-suite/bugs/closed/bug_3777.v | 1 + test-suite/bugs/closed/bug_3815.v | 1 + test-suite/bugs/closed/bug_3828.v | 1 + test-suite/bugs/closed/bug_3849.v | 1 + test-suite/bugs/closed/bug_3854.v | 1 + test-suite/bugs/closed/bug_3895.v | 1 + test-suite/bugs/closed/bug_3896.v | 1 + test-suite/bugs/closed/bug_3920.v | 1 + test-suite/bugs/closed/bug_3922.v | 1 + test-suite/bugs/closed/bug_3938.v | 1 + test-suite/bugs/closed/bug_3943.v | 1 + test-suite/bugs/closed/bug_3944.v | 1 + test-suite/bugs/closed/bug_3953.v | 1 + test-suite/bugs/closed/bug_3974.v | 1 + test-suite/bugs/closed/bug_3975.v | 1 + test-suite/bugs/closed/bug_3993.v | 1 + test-suite/bugs/closed/bug_4018.v | 1 + test-suite/bugs/closed/bug_4034.v | 1 + test-suite/bugs/closed/bug_4035.v | 1 + test-suite/bugs/closed/bug_4057.v | 1 + test-suite/bugs/closed/bug_4089.v | 1 + test-suite/bugs/closed/bug_4095.v | 1 + test-suite/bugs/closed/bug_4101.v | 1 + test-suite/bugs/closed/bug_4103.v | 1 + test-suite/bugs/closed/bug_4116.v | 2 ++ test-suite/bugs/closed/bug_4151.v | 2 ++ test-suite/bugs/closed/bug_4165.v | 1 + test-suite/bugs/closed/bug_4187.v | 5 ++++ test-suite/bugs/closed/bug_4190.v | 3 ++ test-suite/bugs/closed/bug_4205.v | 1 + test-suite/bugs/closed/bug_4216.v | 1 + test-suite/bugs/closed/bug_4217.v | 1 + test-suite/bugs/closed/bug_4221.v | 1 + test-suite/bugs/closed/bug_4234.v | 1 + test-suite/bugs/closed/bug_4240.v | 1 + test-suite/bugs/closed/bug_4256.v | 1 + test-suite/bugs/closed/bug_4284.v | 1 + test-suite/bugs/closed/bug_4287.v | 6 +++- test-suite/bugs/closed/bug_4299.v | 1 + test-suite/bugs/closed/bug_4325.v | 1 + test-suite/bugs/closed/bug_4347.v | 1 + test-suite/bugs/closed/bug_4378.v | 1 + test-suite/bugs/closed/bug_4397.v | 1 + test-suite/bugs/closed/bug_4404.v | 1 + test-suite/bugs/closed/bug_4412.v | 1 + test-suite/bugs/closed/bug_4416.v | 1 + test-suite/bugs/closed/bug_4453.v | 2 ++ test-suite/bugs/closed/bug_4456.v | 4 +++ test-suite/bugs/closed/bug_4462.v | 1 + test-suite/bugs/closed/bug_4464.v | 1 + test-suite/bugs/closed/bug_4471.v | 1 + test-suite/bugs/closed/bug_4479.v | 1 + test-suite/bugs/closed/bug_4480.v | 1 + test-suite/bugs/closed/bug_4484.v | 1 + test-suite/bugs/closed/bug_4511.v | 1 + test-suite/bugs/closed/bug_4527.v | 2 ++ test-suite/bugs/closed/bug_4529.v | 1 + test-suite/bugs/closed/bug_4533.v | 2 ++ test-suite/bugs/closed/bug_4574.v | 1 + test-suite/bugs/closed/bug_4580.v | 1 + test-suite/bugs/closed/bug_4596.v | 1 + test-suite/bugs/closed/bug_4644.v | 1 + test-suite/bugs/closed/bug_4661.v | 1 + test-suite/bugs/closed/bug_4673.v | 1 + test-suite/bugs/closed/bug_4725.v | 5 ++-- test-suite/bugs/closed/bug_4811.v | 1 + test-suite/bugs/closed/bug_4813.v | 1 + test-suite/bugs/closed/bug_4818.v | 1 + test-suite/bugs/closed/bug_4893.v | 1 + test-suite/bugs/closed/bug_4969.v | 1 + test-suite/bugs/closed/bug_5045.v | 1 + test-suite/bugs/closed/bug_5078.v | 1 + test-suite/bugs/closed/bug_5093.v | 1 + test-suite/bugs/closed/bug_5095.v | 1 + test-suite/bugs/closed/bug_5153.v | 1 + test-suite/bugs/closed/bug_5180.v | 1 + test-suite/bugs/closed/bug_5193.v | 1 + test-suite/bugs/closed/bug_5203.v | 1 + test-suite/bugs/closed/bug_5219.v | 1 + test-suite/bugs/closed/bug_5321.v | 1 + test-suite/bugs/closed/bug_5322.v | 1 + test-suite/bugs/closed/bug_5359.v | 1 + test-suite/bugs/closed/bug_5372.v | 1 + test-suite/bugs/closed/bug_5414.v | 1 + test-suite/bugs/closed/bug_5434.v | 1 + test-suite/bugs/closed/bug_5449.v | 1 + test-suite/bugs/closed/bug_5476.v | 1 + test-suite/bugs/closed/bug_5486.v | 1 + test-suite/bugs/closed/bug_5487.v | 1 + test-suite/bugs/closed/bug_5501.v | 1 + test-suite/bugs/closed/bug_5547.v | 1 + test-suite/bugs/closed/bug_5578.v | 1 + test-suite/bugs/closed/bug_5666.v | 1 + test-suite/bugs/closed/bug_5671.v | 1 + test-suite/bugs/closed/bug_5707.v | 1 + test-suite/bugs/closed/bug_5741.v | 1 + test-suite/bugs/closed/bug_5749.v | 3 ++ test-suite/bugs/closed/bug_5750.v | 1 + test-suite/bugs/closed/bug_5757.v | 1 + test-suite/bugs/closed/bug_6534.v | 1 + test-suite/bugs/closed/bug_6631.v | 1 + test-suite/bugs/closed/bug_7392.v | 1 + test-suite/bugs/opened/HoTT_coq_106.v | 1 + test-suite/bugs/opened/bug_3277.v | 1 + test-suite/bugs/opened/bug_3311.v | 1 + test-suite/bugs/opened/bug_3312.v | 1 + test-suite/bugs/opened/bug_3343.v | 1 + test-suite/bugs/opened/bug_3345.v | 1 + test-suite/bugs/opened/bug_3370.v | 1 + test-suite/bugs/opened/bug_3395.v | 1 + test-suite/bugs/opened/bug_3463.v | 1 + test-suite/bugs/opened/bug_3655.v | 1 + test-suite/bugs/opened/bug_4755.v | 1 + test-suite/bugs/opened/bug_4778.v | 1 + test-suite/failure/ClearBody.v | 1 + test-suite/failure/Reordering.v | 1 + test-suite/failure/Sections.v | 2 ++ test-suite/failure/Tauto.v | 1 + test-suite/failure/autorewritein.v | 4 +-- test-suite/failure/clashes.v | 1 + test-suite/failure/coqbugs0266.v | 2 ++ test-suite/failure/evarclear1.v | 2 +- test-suite/failure/evarclear2.v | 1 + test-suite/failure/fixpoint2.v | 1 + test-suite/failure/ltac1.v | 1 + test-suite/failure/ltac2.v | 1 + test-suite/failure/ltac4.v | 2 +- test-suite/failure/pattern.v | 1 + test-suite/failure/prop_set_proof_irrelevance.v | 1 + test-suite/failure/rewrite_in_goal.v | 1 + test-suite/failure/rewrite_in_hyp.v | 1 + test-suite/failure/rewrite_in_hyp2.v | 1 + test-suite/failure/subtyping.v | 7 +++++ test-suite/modules/SeveralWith.v | 1 + test-suite/modules/WithDefUBinders.v | 2 ++ test-suite/modules/errors.v | 40 ++++++++++++++++++------- test-suite/modules/fun_objects.v | 1 + test-suite/output/Cases.v | 1 + test-suite/output/Errors.v | 3 ++ test-suite/output/Existentials.v | 2 ++ test-suite/output/Match_subterm.v | 1 + test-suite/output/Naming.v | 1 + test-suite/output/ShowMatch.v | 1 + test-suite/output/ShowProof.v | 1 + test-suite/output/Tactics.v | 1 + test-suite/output/TypeclassDebug.v | 1 + test-suite/output/names.v | 1 + test-suite/output/optimize_heap.v | 1 + test-suite/output/rewrite_2172.v | 1 + test-suite/success/CaseInClause.v | 1 + test-suite/success/ImplicitArguments.v | 1 + test-suite/success/Print.v | 1 + test-suite/success/Scopes.v | 2 +- test-suite/success/attribute_syntax.v | 1 + test-suite/success/autorewrite.v | 1 + test-suite/success/change_pattern.v | 1 + test-suite/success/rewrite_evar.v | 1 + test-suite/success/setoid_unif.v | 1 + test-suite/success/unfold.v | 1 + test-suite/success/unidecls.v | 12 ++++---- 294 files changed, 394 insertions(+), 27 deletions(-) diff --git a/test-suite/Makefile b/test-suite/Makefile index bde0bfc91f..e35393b5e8 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -60,7 +60,6 @@ SINGLE_QUOTE=" # wrap the arguments in parens, but only if they exist get_coq_prog_args_in_parens = $(subst $(SINGLE_QUOTE),,$(if $(call get_coq_prog_args,$(1)), ($(call get_coq_prog_args,$(1))))) # get the command to use with this set of arguments; if there's -compile, use coqc, else use coqtop -has_compile_flag = $(filter "-compile",$(call get_coq_prog_args,$(1))) has_profile_ltac_or_compile_flag = $(filter "-profile-ltac-cutoff" "-profile-ltac" "-compile",$(call get_coq_prog_args,$(1))) get_command_based_on_flags = $(if $(call has_profile_ltac_or_compile_flag,$(1)),$(coqtopcompile),$(coqtopload)) @@ -308,7 +307,7 @@ ssr: $(wildcard ssr/*.v:%.v=%.v.log) $(addsuffix .log,$(wildcard ssr/*.v success/*.v micromega/*.v modules/*.v)): %.v.log: %.v $(PREREQUISITELOG) @echo "TEST $< $(call get_coq_prog_args_in_parens,"$<")" $(HIDE){ \ - opts="$(if $(findstring modules/,$<),-R modules Mods -impredicative-set)"; \ + opts="$(if $(findstring modules/,$<),-R modules Mods)"; \ echo $(call log_intro,$<); \ $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") $$opts 2>&1; R=$$?; times; \ if [ $$R = 0 ]; then \ diff --git a/test-suite/bugs/closed/HoTT_coq_002.v b/test-suite/bugs/closed/HoTT_coq_002.v index dba4d5998f..fbafc97580 100644 --- a/test-suite/bugs/closed/HoTT_coq_002.v +++ b/test-suite/bugs/closed/HoTT_coq_002.v @@ -31,3 +31,4 @@ F : @SpecializedFunctor (* Top.516 *) objC C The term "F" has type "@SpecializedFunctor (* Top.516 *) objC C" while it is expected to have type "@SpecializedFunctor (* Top.519 Top.520 *) objC C". *) +End FunctorInterface. diff --git a/test-suite/bugs/closed/HoTT_coq_014.v b/test-suite/bugs/closed/HoTT_coq_014.v index 5c45036643..35f8701b2f 100644 --- a/test-suite/bugs/closed/HoTT_coq_014.v +++ b/test-suite/bugs/closed/HoTT_coq_014.v @@ -200,3 +200,4 @@ Polymorphic Definition UnderlyingGraphFunctor_MorphismOf (C D : SmallCategory) ( Morphism (FunctorCategory GraphIndexingCategory TypeCat) (UnderlyingGraph C) (UnderlyingGraph D). (* Anomaly: apply_coercion. Please report.*) Proof. Admitted. +End test. diff --git a/test-suite/bugs/closed/HoTT_coq_028.v b/test-suite/bugs/closed/HoTT_coq_028.v index b03241402f..99bde6d7c0 100644 --- a/test-suite/bugs/closed/HoTT_coq_028.v +++ b/test-suite/bugs/closed/HoTT_coq_028.v @@ -12,3 +12,4 @@ Error: Cannot instantiate metavariable P of type match eq_sym e in (_ = y) return (T (f y) (f x)) with | eq_refl => m (f x) end = m (f x)" of incompatible type "forall x : O, x = x -> Prop". *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_042.v b/test-suite/bugs/closed/HoTT_coq_042.v index 432cf7054f..e2eedd16e3 100644 --- a/test-suite/bugs/closed/HoTT_coq_042.v +++ b/test-suite/bugs/closed/HoTT_coq_042.v @@ -26,3 +26,4 @@ Let SetCatFoo' : Foo. (* Toplevel input, characters 15-20: Error: Universe inconsistency (cannot enforce Set <= Prop). *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_044.v b/test-suite/bugs/closed/HoTT_coq_044.v index c824f53ba8..78b675eab9 100644 --- a/test-suite/bugs/closed/HoTT_coq_044.v +++ b/test-suite/bugs/closed/HoTT_coq_044.v @@ -33,3 +33,4 @@ r2 : Row (* Top.56 Top.57 *) Ts The term "Row (* Coq.Init.Logic.8 Top.59 *) Ts" has type "Type (* max(Top.58+1, Top.59) *)" while it is expected to have type "Type (* Coq.Init.Logic.8 *)" (Universe inconsistency). *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_047.v b/test-suite/bugs/closed/HoTT_coq_047.v index bef3c33ca1..219689f9fc 100644 --- a/test-suite/bugs/closed/HoTT_coq_047.v +++ b/test-suite/bugs/closed/HoTT_coq_047.v @@ -46,3 +46,4 @@ Proof. destruct n0. destruct cr. (* Anomaly: Evar ?nnn was not declared. Please report. *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_049.v b/test-suite/bugs/closed/HoTT_coq_049.v index 906ec329e0..31e7861de4 100644 --- a/test-suite/bugs/closed/HoTT_coq_049.v +++ b/test-suite/bugs/closed/HoTT_coq_049.v @@ -4,3 +4,4 @@ Goal forall y, @f_equal = y. intro. apply functional_extensionality_dep. (* Error: Ill-typed evar instance in HoTT/coq, Anomaly: Uncaught exception Reductionops.NotASort(_). Please report. before that. *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_057.v b/test-suite/bugs/closed/HoTT_coq_057.v index e72ce0c5ec..1405232b8e 100644 --- a/test-suite/bugs/closed/HoTT_coq_057.v +++ b/test-suite/bugs/closed/HoTT_coq_057.v @@ -31,3 +31,4 @@ Proof. Set Printing Universes. try (apply IHsub in X). (* Toplevel input, characters 5-21: Error: Universe inconsistency (cannot enforce Top.47 = Set). *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_058.v b/test-suite/bugs/closed/HoTT_coq_058.v index 3d16e7ac0d..09e4365ebe 100644 --- a/test-suite/bugs/closed/HoTT_coq_058.v +++ b/test-suite/bugs/closed/HoTT_coq_058.v @@ -139,3 +139,4 @@ let T1 := lazymatch type of F with (?T -> _) -> _ => constr:(T) end in rewrite transport_path_prod'_beta'. (* Anomaly: Uncaught exception Invalid_argument("to_constraints: non-trivial algebraic constraint between universes", _). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_059.v b/test-suite/bugs/closed/HoTT_coq_059.v index 2e6c735cf5..9800ba8e45 100644 --- a/test-suite/bugs/closed/HoTT_coq_059.v +++ b/test-suite/bugs/closed/HoTT_coq_059.v @@ -15,3 +15,4 @@ Section foo. (* Toplevel input, characters 0-60: Error: Universe inconsistency (cannot enforce Top.24 <= Top.23 because Top.23 < Top.22 <= Top.24). *) +End foo. diff --git a/test-suite/bugs/closed/HoTT_coq_079.v b/test-suite/bugs/closed/HoTT_coq_079.v index e70de9ca99..7e782139ea 100644 --- a/test-suite/bugs/closed/HoTT_coq_079.v +++ b/test-suite/bugs/closed/HoTT_coq_079.v @@ -14,3 +14,4 @@ Hint Resolve H : bar. Goal forall y : foo, @x y = @x y. intro y. progress auto with bar. (* failed to progress *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_083.v b/test-suite/bugs/closed/HoTT_coq_083.v index 494b25c7b1..02c4b22a4d 100644 --- a/test-suite/bugs/closed/HoTT_coq_083.v +++ b/test-suite/bugs/closed/HoTT_coq_083.v @@ -27,3 +27,4 @@ generalize dependent (@ob C). intros T t. (* Toplevel input, characters 9-10: Error: No product even after head-reduction. *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_099.v b/test-suite/bugs/closed/HoTT_coq_099.v index cd5b0c8ff6..a9119052cb 100644 --- a/test-suite/bugs/closed/HoTT_coq_099.v +++ b/test-suite/bugs/closed/HoTT_coq_099.v @@ -60,3 +60,4 @@ Top.168 <= Coq.Init.Datatypes.28 Top.169 <= Coq.Init.Datatypes.29 Top.169 <= Coq.Init.Datatypes.28 (maybe a bugged tactic). *) +End PreMonoidalCategory. diff --git a/test-suite/bugs/closed/HoTT_coq_100.v b/test-suite/bugs/closed/HoTT_coq_100.v index 663b6280e4..660283116d 100644 --- a/test-suite/bugs/closed/HoTT_coq_100.v +++ b/test-suite/bugs/closed/HoTT_coq_100.v @@ -150,3 +150,4 @@ cannot be applied to the terms Top.313 Top.314 Top.306 Top.316 Top.305 *)" The 4th term has type "Category (* Top.300 Set *) unit" which should be coercible to "Category (* Top.300 Top.307 *) unit". *) +End CommaCategoryProjectionFunctor. diff --git a/test-suite/bugs/closed/HoTT_coq_101.v b/test-suite/bugs/closed/HoTT_coq_101.v index 3ef56892be..777fd8600a 100644 --- a/test-suite/bugs/closed/HoTT_coq_101.v +++ b/test-suite/bugs/closed/HoTT_coq_101.v @@ -76,3 +76,4 @@ Section FullyFaithful. Check @FunctorProduct' C TypeCatC YC. (* Toplevel input, characters 0-37: Error: Universe inconsistency. Cannot enforce Top.187 = Top.186 because Top.186 <= Top.189 < Top.191 <= Top.187). *) +End FullyFaithful. diff --git a/test-suite/bugs/closed/HoTT_coq_112.v b/test-suite/bugs/closed/HoTT_coq_112.v index 5bee69fcde..c3ef2aa1a7 100644 --- a/test-suite/bugs/closed/HoTT_coq_112.v +++ b/test-suite/bugs/closed/HoTT_coq_112.v @@ -74,3 +74,4 @@ The 1st term has type "Univalence (* Top.934 Top.935 Top.936 Top.937 *)" which should be coercible to "Univalence (* Top.1003 Top.1003 Top.1001 Top.997 *)". *) +End Univalence. diff --git a/test-suite/bugs/closed/HoTT_coq_118.v b/test-suite/bugs/closed/HoTT_coq_118.v index e41689cba3..37b6ff66a1 100644 --- a/test-suite/bugs/closed/HoTT_coq_118.v +++ b/test-suite/bugs/closed/HoTT_coq_118.v @@ -34,3 +34,4 @@ p : tt = tt ?46 : "Contr_internal (idpath = p)" *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_120.v b/test-suite/bugs/closed/HoTT_coq_120.v index e46ea58bb3..a80d075f69 100644 --- a/test-suite/bugs/closed/HoTT_coq_120.v +++ b/test-suite/bugs/closed/HoTT_coq_120.v @@ -136,3 +136,5 @@ Section fully_faithful_helpers. Set Printing Universes. admit. (* Error: Universe inconsistency (cannot enforce Top.235 <= Set because Set < Top.235). *) + Abort. +End fully_faithful_helpers. diff --git a/test-suite/bugs/closed/HoTT_coq_123.v b/test-suite/bugs/closed/HoTT_coq_123.v index 7bed956f3e..f688f51222 100644 --- a/test-suite/bugs/closed/HoTT_coq_123.v +++ b/test-suite/bugs/closed/HoTT_coq_123.v @@ -174,3 +174,4 @@ Section FunctorSectionCategory. _); abstract (path_natural_transformation; admit). Defined. (* Stack overflow *) +End FunctorSectionCategory. diff --git a/test-suite/bugs/closed/bug_1341.v b/test-suite/bugs/closed/bug_1341.v index 79a0a14d7c..9bdfffea3e 100644 --- a/test-suite/bugs/closed/bug_1341.v +++ b/test-suite/bugs/closed/bug_1341.v @@ -15,3 +15,5 @@ intros A B a b c f Hab Hbc. rewrite Hab. assumption. Qed. + +End Setoid_Bug. diff --git a/test-suite/bugs/closed/bug_1414.v b/test-suite/bugs/closed/bug_1414.v index ee9e2504a6..ab490fa315 100644 --- a/test-suite/bugs/closed/bug_1414.v +++ b/test-suite/bugs/closed/bug_1414.v @@ -38,3 +38,4 @@ Program Fixpoint union let (l1', r1') := split v2 u in join (union l1' l2 _ _ _ _) v2 (union (snd r1') r2 _ _ _ _) end. +Reset union. diff --git a/test-suite/bugs/closed/bug_1416.v b/test-suite/bugs/closed/bug_1416.v index 667c6b1d5f..87ecce5c1d 100644 --- a/test-suite/bugs/closed/bug_1416.v +++ b/test-suite/bugs/closed/bug_1416.v @@ -27,3 +27,4 @@ Lemma autorewrite_raise_anomaly: forall (Env A:Type) (e: Env) (p:Place Env A), Proof. intros Env A e p; eapply ex_intro. autorewrite with placeeq. (* Here is the bug *) +Abort. diff --git a/test-suite/bugs/closed/bug_1501.v b/test-suite/bugs/closed/bug_1501.v index e771e192dc..64eea68c37 100644 --- a/test-suite/bugs/closed/bug_1501.v +++ b/test-suite/bugs/closed/bug_1501.v @@ -65,3 +65,5 @@ Proof. setoid_rewrite H2. reflexivity. Qed. + +End Essais. diff --git a/test-suite/bugs/closed/bug_1542.v b/test-suite/bugs/closed/bug_1542.v index 52cfbbc496..1def7f4dba 100644 --- a/test-suite/bugs/closed/bug_1542.v +++ b/test-suite/bugs/closed/bug_1542.v @@ -38,3 +38,5 @@ intro; constructor 2. ^^^^^^^^^^^^^ Error: Impossible to unify (seq.toto ?3 (seq.t.f2 ?3)) with (seq.toto a (t'.f2 a)).*) +Abort. +End koko. diff --git a/test-suite/bugs/closed/bug_1545.v b/test-suite/bugs/closed/bug_1545.v index 9ef796faf7..91ce4a76af 100644 --- a/test-suite/bugs/closed/bug_1545.v +++ b/test-suite/bugs/closed/bug_1545.v @@ -18,3 +18,5 @@ Module ti:=ta.t. Definition ex1:forall (c d:ti.X), (ta.a d)=(ta.a c) -> d=c. intros. injection H. +Abort. +End toto. diff --git a/test-suite/bugs/closed/bug_1683.v b/test-suite/bugs/closed/bug_1683.v index 802057fa8c..8ab030a297 100644 --- a/test-suite/bugs/closed/bug_1683.v +++ b/test-suite/bugs/closed/bug_1683.v @@ -37,3 +37,5 @@ rewrite foobar. rewrite foobar in H. assumption. Qed. + +End SetoidBug. diff --git a/test-suite/bugs/closed/bug_1773.v b/test-suite/bugs/closed/bug_1773.v index 211af89b70..c930f24df7 100644 --- a/test-suite/bugs/closed/bug_1773.v +++ b/test-suite/bugs/closed/bug_1773.v @@ -7,3 +7,4 @@ Proof. econstructor. intros X. apply X. (* used to fail here *) +Abort. diff --git a/test-suite/bugs/closed/bug_1865.v b/test-suite/bugs/closed/bug_1865.v index 17c1998948..8bbe07881c 100644 --- a/test-suite/bugs/closed/bug_1865.v +++ b/test-suite/bugs/closed/bug_1865.v @@ -16,3 +16,4 @@ Definition f (n:nat) : Type := Goal forall A n, list A n -> f n. intros A n. dependent inversion n. +Abort. diff --git a/test-suite/bugs/closed/bug_1918.v b/test-suite/bugs/closed/bug_1918.v index 9d92fe12b8..5d1f9edb3e 100644 --- a/test-suite/bugs/closed/bug_1918.v +++ b/test-suite/bugs/closed/bug_1918.v @@ -374,3 +374,4 @@ Proof. Abort. +End BushDep. diff --git a/test-suite/bugs/closed/bug_1944.v b/test-suite/bugs/closed/bug_1944.v index ee2918c6e9..f996eeecc6 100644 --- a/test-suite/bugs/closed/bug_1944.v +++ b/test-suite/bugs/closed/bug_1944.v @@ -7,3 +7,4 @@ Lemma bug : forall n, J n -> J (S n). Proof. intros ? H. induction H as [? ? [? ?]]. +Abort. diff --git a/test-suite/bugs/closed/bug_1963.v b/test-suite/bugs/closed/bug_1963.v index 11e2ee44d6..354056ae2a 100644 --- a/test-suite/bugs/closed/bug_1963.v +++ b/test-suite/bugs/closed/bug_1963.v @@ -17,3 +17,4 @@ Lemma inv : forall (A:Type)(n n':nat)(ts':illist A n'), n' = S n -> Proof. intros. dependent inversion ts'. +Abort. diff --git a/test-suite/bugs/closed/bug_2016.v b/test-suite/bugs/closed/bug_2016.v index 927021a259..a82fd87986 100644 --- a/test-suite/bugs/closed/bug_2016.v +++ b/test-suite/bugs/closed/bug_2016.v @@ -62,3 +62,4 @@ apply sym_eq. Show Universes. Print Universes. Fail apply H0. +Abort. diff --git a/test-suite/bugs/closed/bug_2117.v b/test-suite/bugs/closed/bug_2117.v index 50c925617e..b68554a52a 100644 --- a/test-suite/bugs/closed/bug_2117.v +++ b/test-suite/bugs/closed/bug_2117.v @@ -54,3 +54,4 @@ Subst. apply copyf_atom. Show Existentials. apply H1. +Abort. diff --git a/test-suite/bugs/closed/bug_2123.v b/test-suite/bugs/closed/bug_2123.v index 2957e53e3c..0ff8bda6dc 100644 --- a/test-suite/bugs/closed/bug_2123.v +++ b/test-suite/bugs/closed/bug_2123.v @@ -7,3 +7,4 @@ Parameter widen : forall (n : nat) (s : fset n), { x : fset (S n) | s=s }. Goal forall i, fset (S i). intro. refine (proj1_sig (widen i _)). +Abort. diff --git a/test-suite/bugs/closed/bug_2139.v b/test-suite/bugs/closed/bug_2139.v index e2e4784965..07b94d540a 100644 --- a/test-suite/bugs/closed/bug_2139.v +++ b/test-suite/bugs/closed/bug_2139.v @@ -22,3 +22,4 @@ apply flip in H. type of (@flip _ _ _ _) itself had non-normalized evars *) (* By the way, is the check necessary ? *) +Abort. diff --git a/test-suite/bugs/closed/bug_2164.v b/test-suite/bugs/closed/bug_2164.v index 6adb3577be..9119a02419 100644 --- a/test-suite/bugs/closed/bug_2164.v +++ b/test-suite/bugs/closed/bug_2164.v @@ -332,3 +332,4 @@ exists lv''. [| |t' lv''' lv'''' rv''' ee'' ee_sub' H2 (H3_1,H3_2,H3_3) (H4_1,H4_2,H4_3,H4_4,H4_5) H5 (H6_1,H6_2)| | | |]. (* Check that all names are the given ones: *) clear t' lv''' lv'''' rv''' ee'' ee_sub' H2 H3_1 H3_2 H3_3 H4_1 H4_2 H4_3 H4_4 H4_5 H5 H6_1 H6_2. +Abort. diff --git a/test-suite/bugs/closed/bug_2243.v b/test-suite/bugs/closed/bug_2243.v index 6d45c9a09e..65a4c15eff 100644 --- a/test-suite/bugs/closed/bug_2243.v +++ b/test-suite/bugs/closed/bug_2243.v @@ -7,3 +7,5 @@ Proof. destruct H. Undo. revert H; intro H; destruct H. +Abort. +End O. diff --git a/test-suite/bugs/closed/bug_2244.v b/test-suite/bugs/closed/bug_2244.v index d72c51f216..948251082c 100644 --- a/test-suite/bugs/closed/bug_2244.v +++ b/test-suite/bugs/closed/bug_2244.v @@ -17,3 +17,4 @@ Proof. (* still not compatible with 8.2 because an evar can be solved in two different ways and is left open *) +Abort. diff --git a/test-suite/bugs/closed/bug_2255.v b/test-suite/bugs/closed/bug_2255.v index ae5024fddd..7981dc1f20 100644 --- a/test-suite/bugs/closed/bug_2255.v +++ b/test-suite/bugs/closed/bug_2255.v @@ -19,3 +19,4 @@ n0 & Tuple n0 H0}) (consT A F) (cons A x F X))), False. intros. injection H. +Abort. diff --git a/test-suite/bugs/closed/bug_2295.v b/test-suite/bugs/closed/bug_2295.v index f5ca28dcaa..584edf19b9 100644 --- a/test-suite/bugs/closed/bug_2295.v +++ b/test-suite/bugs/closed/bug_2295.v @@ -9,3 +9,5 @@ Definition d' := | true => or_introl _ (refl_equal true) | false => or_intror _ (refl_equal false) end). + +End sec. diff --git a/test-suite/bugs/closed/bug_2299.v b/test-suite/bugs/closed/bug_2299.v index c0552ca7b3..2f0aad90b6 100644 --- a/test-suite/bugs/closed/bug_2299.v +++ b/test-suite/bugs/closed/bug_2299.v @@ -11,3 +11,6 @@ Let unused := T tt. Goal T tt -> False. intro X. destruct X. +Abort. + +End test. diff --git a/test-suite/bugs/closed/bug_2320.v b/test-suite/bugs/closed/bug_2320.v index 1616a29de6..8c9b1f5049 100644 --- a/test-suite/bugs/closed/bug_2320.v +++ b/test-suite/bugs/closed/bug_2320.v @@ -12,3 +12,4 @@ Lemma failure : forall (x : dummy 0), x = constr. Proof. intros x. refine (match x with constr => _ end). +Abort. diff --git a/test-suite/bugs/closed/bug_2350.v b/test-suite/bugs/closed/bug_2350.v index e91f22e267..18c7ebda54 100644 --- a/test-suite/bugs/closed/bug_2350.v +++ b/test-suite/bugs/closed/bug_2350.v @@ -4,3 +4,4 @@ Definition foo := forall n:nat, n=n. Definition bar : foo. refine (fix aux (n:nat) := _). +Abort. diff --git a/test-suite/bugs/closed/bug_2360.v b/test-suite/bugs/closed/bug_2360.v index 9aea5f3615..1aed53c6ed 100644 --- a/test-suite/bugs/closed/bug_2360.v +++ b/test-suite/bugs/closed/bug_2360.v @@ -10,3 +10,4 @@ Definition some_value (etyp : nat -> Type) : (Value etyp). Proof. intros. Fail apply Mk. (* Check that it does not raise an anomaly *) +Abort. diff --git a/test-suite/bugs/closed/bug_2378.v b/test-suite/bugs/closed/bug_2378.v index b9dd654057..a96a23ff40 100644 --- a/test-suite/bugs/closed/bug_2378.v +++ b/test-suite/bugs/closed/bug_2378.v @@ -608,3 +608,6 @@ Next Obligation. Qed. End Product. + +End TRANSFO. +End TTS_TASM. diff --git a/test-suite/bugs/closed/bug_2404.v b/test-suite/bugs/closed/bug_2404.v index f6ec676014..c284a15651 100644 --- a/test-suite/bugs/closed/bug_2404.v +++ b/test-suite/bugs/closed/bug_2404.v @@ -44,3 +44,5 @@ Fixpoint exportRweak {a b} (aRWb : Rweak a b) (y : bName b) : option (bName a) : | None => None end end. + +End Derived. diff --git a/test-suite/bugs/closed/bug_2602.v b/test-suite/bugs/closed/bug_2602.v index 29c8ac16b2..dd3551a7c3 100644 --- a/test-suite/bugs/closed/bug_2602.v +++ b/test-suite/bugs/closed/bug_2602.v @@ -6,3 +6,4 @@ match goal with | |- S a > 0 => idtac end end. +Abort. diff --git a/test-suite/bugs/closed/bug_2616.v b/test-suite/bugs/closed/bug_2616.v index 0be5b6c2c5..fee91dab24 100644 --- a/test-suite/bugs/closed/bug_2616.v +++ b/test-suite/bugs/closed/bug_2616.v @@ -5,3 +5,4 @@ Goal Proof. intros. Fail rewrite IN in H. +Abort. diff --git a/test-suite/bugs/closed/bug_2729.v b/test-suite/bugs/closed/bug_2729.v index c9d65c12c7..ff08bdc6bb 100644 --- a/test-suite/bugs/closed/bug_2729.v +++ b/test-suite/bugs/closed/bug_2729.v @@ -113,3 +113,4 @@ Lemma insertBaseConsLt {pu : PatchUniverse} : insertBase p (Cons q rs) = Cons p (Cons q rs). Proof. vm_compute. +Abort. diff --git a/test-suite/bugs/closed/bug_2817.v b/test-suite/bugs/closed/bug_2817.v index 08dff99287..5125ce072f 100644 --- a/test-suite/bugs/closed/bug_2817.v +++ b/test-suite/bugs/closed/bug_2817.v @@ -7,3 +7,4 @@ False. intros. Fail apply H in H0. (* should fail without exhausting the stack *) +Abort. diff --git a/test-suite/bugs/closed/bug_2828.v b/test-suite/bugs/closed/bug_2828.v index 0b8abace22..36ac4605f4 100644 --- a/test-suite/bugs/closed/bug_2828.v +++ b/test-suite/bugs/closed/bug_2828.v @@ -2,3 +2,4 @@ Parameter A B : Type. Coercion POL (p : prod A B) := fst p. Goal forall x : prod A B, A. intro x. Fail exact x. +Abort. diff --git a/test-suite/bugs/closed/bug_2834.v b/test-suite/bugs/closed/bug_2834.v index 6015c53b8a..afa405b8dd 100644 --- a/test-suite/bugs/closed/bug_2834.v +++ b/test-suite/bugs/closed/bug_2834.v @@ -2,3 +2,4 @@ Lemma eqType2Set (a b : Set) (H : @eq Type a b) : @eq Set a b. Fail subst. +Abort. diff --git a/test-suite/bugs/closed/bug_2836.v b/test-suite/bugs/closed/bug_2836.v index a948b75e27..a2755be7dd 100644 --- a/test-suite/bugs/closed/bug_2836.v +++ b/test-suite/bugs/closed/bug_2836.v @@ -37,3 +37,5 @@ Fail refine {| Compose' := (fun s d d' m2 m1 => (Compose (fst m2) (fst m1), Compose (snd m2) (snd m1))) |}. +Abort. +End ProductCategory. diff --git a/test-suite/bugs/closed/bug_2837.v b/test-suite/bugs/closed/bug_2837.v index 52a56c2cff..9982b96f79 100644 --- a/test-suite/bugs/closed/bug_2837.v +++ b/test-suite/bugs/closed/bug_2837.v @@ -13,3 +13,4 @@ Fail (intros; rewrite test). (* III) a working variant: *) intros; rewrite (test n m). +Abort. diff --git a/test-suite/bugs/closed/bug_2839.v b/test-suite/bugs/closed/bug_2839.v index e727e26061..7388555a1f 100644 --- a/test-suite/bugs/closed/bug_2839.v +++ b/test-suite/bugs/closed/bug_2839.v @@ -8,3 +8,4 @@ Fail | [ H : context G [@eq _ _] |- _ ] => let H' := context G[@plus 2] in H' end in pose H. +Abort. diff --git a/test-suite/bugs/closed/bug_2854.v b/test-suite/bugs/closed/bug_2854.v index 14aee17ff0..6bc102f569 100644 --- a/test-suite/bugs/closed/bug_2854.v +++ b/test-suite/bugs/closed/bug_2854.v @@ -5,3 +5,5 @@ Section foo. subst foo. Fail pose bar as f. (* simpl in f. *) + Abort. +End foo. diff --git a/test-suite/bugs/closed/bug_2883.v b/test-suite/bugs/closed/bug_2883.v index f027b5eb29..9170ce41ca 100644 --- a/test-suite/bugs/closed/bug_2883.v +++ b/test-suite/bugs/closed/bug_2883.v @@ -33,3 +33,5 @@ Proof. eapply IHstar; eauto. replace s2 with (State a' e b') by admit. eauto. Qed. (* Oups *) + +End Test. diff --git a/test-suite/bugs/closed/bug_2900.v b/test-suite/bugs/closed/bug_2900.v index 8f4264e910..93ea71848b 100644 --- a/test-suite/bugs/closed/bug_2900.v +++ b/test-suite/bugs/closed/bug_2900.v @@ -26,3 +26,4 @@ Proof. intros * E Hp. (* bug goes away if [revert E] is called explicitly *) dependent induction Hp. +Abort. diff --git a/test-suite/bugs/closed/bug_2946.v b/test-suite/bugs/closed/bug_2946.v index c8b7255e7b..9c96ae021e 100644 --- a/test-suite/bugs/closed/bug_2946.v +++ b/test-suite/bugs/closed/bug_2946.v @@ -6,3 +6,5 @@ assert (pairE1 := let Exy := _ in (Ex_ y, E_y _) : Exy * Exy). (* FAIL *) assert (pairE2 := let Exy := _ in (Ex_ _, E_y x) : Exy * Exy). + +Abort. diff --git a/test-suite/bugs/closed/bug_2995.v b/test-suite/bugs/closed/bug_2995.v index b6c5b6df44..1a4d7e5040 100644 --- a/test-suite/bugs/closed/bug_2995.v +++ b/test-suite/bugs/closed/bug_2995.v @@ -7,3 +7,7 @@ Module Implementation <: Interface. Definition error: t := false. Fail End Implementation. (* A UserError here is expected, not an uncaught Not_found *) + + Reset error. + Definition error := 0. +End Implementation. diff --git a/test-suite/bugs/closed/bug_2996.v b/test-suite/bugs/closed/bug_2996.v index d5409289c5..6736db898d 100644 --- a/test-suite/bugs/closed/bug_2996.v +++ b/test-suite/bugs/closed/bug_2996.v @@ -29,3 +29,5 @@ Section x. set (T := False). Fail pose proof p as H. Abort. + +End x. diff --git a/test-suite/bugs/closed/bug_3003.v b/test-suite/bugs/closed/bug_3003.v index 2f8bcdae7a..2484605f54 100644 --- a/test-suite/bugs/closed/bug_3003.v +++ b/test-suite/bugs/closed/bug_3003.v @@ -10,3 +10,4 @@ Inductive G_Edge : G_Vertex -> G_Vertex -> Set := G_e : G_Edge G_v0 G_v1. Goal forall x1 : G_Edge G_v1 G_v1, @AddEdge _ G_Edge G_v1 _ _ (NoEdges _ _) x1 = NoEdges _ _. intro x1. try destruct x1. (* now raises a typing error *) +Abort. diff --git a/test-suite/bugs/closed/bug_3016.v b/test-suite/bugs/closed/bug_3016.v index bd4f1dd805..d9fd685eae 100644 --- a/test-suite/bugs/closed/bug_3016.v +++ b/test-suite/bugs/closed/bug_3016.v @@ -2,3 +2,5 @@ Section foo. Variable C : Type. Goal True. change (eq (A := ?C) ?x ?y) with (eq). + Abort. +End foo. diff --git a/test-suite/bugs/closed/bug_3036.v b/test-suite/bugs/closed/bug_3036.v index d60987a9e6..dff15d4e10 100644 --- a/test-suite/bugs/closed/bug_3036.v +++ b/test-suite/bugs/closed/bug_3036.v @@ -167,3 +167,5 @@ Section Stack. Proof. intros. try apply himp_ex_conc_trivial. + Abort. +End Stack. diff --git a/test-suite/bugs/closed/bug_3037.v b/test-suite/bugs/closed/bug_3037.v index baa7eff549..40d1bfde53 100644 --- a/test-suite/bugs/closed/bug_3037.v +++ b/test-suite/bugs/closed/bug_3037.v @@ -9,3 +9,4 @@ Function f_R (a: nat) {wf (fun x y: nat => False) a}:Prop:= end. (* Anomaly: File "plugins/funind/recdef.ml", line 916, characters 13-19: Assertion failed. Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3045.v b/test-suite/bugs/closed/bug_3045.v index b3c8bfecbc..90aa5ee9fd 100644 --- a/test-suite/bugs/closed/bug_3045.v +++ b/test-suite/bugs/closed/bug_3045.v @@ -32,3 +32,4 @@ refine match m with it should work, if destruct were able to do the good generalization in advance, before doing the "intros []". *) Fail destruct (@ReifiedMorphismSimplifyWithProof T s1 d0 d0' m1) as [ [] ? ]. +Abort. diff --git a/test-suite/bugs/closed/bug_3068.v b/test-suite/bugs/closed/bug_3068.v index 04072ae305..00d00b421e 100644 --- a/test-suite/bugs/closed/bug_3068.v +++ b/test-suite/bugs/closed/bug_3068.v @@ -62,3 +62,6 @@ Section Finite_nat_set. (* This was not part of the initial bug report; this is to check that the existential variable kept its name *) change (true = counted_def_nth fs2 i ?def). + + Abort. +End Finite_nat_set. diff --git a/test-suite/bugs/closed/bug_3070.v b/test-suite/bugs/closed/bug_3070.v index 7a8feca587..3ebfaa3131 100644 --- a/test-suite/bugs/closed/bug_3070.v +++ b/test-suite/bugs/closed/bug_3070.v @@ -4,3 +4,4 @@ Lemma foo (a1 a2 : Set) (b1 : a1 -> Prop) (Ha : a1 = a2) (c : a1) (d : b1 c) : True. Proof. subst. +Abort. diff --git a/test-suite/bugs/closed/bug_3100.v b/test-suite/bugs/closed/bug_3100.v index 6f35a74dc1..37e0cb7119 100644 --- a/test-suite/bugs/closed/bug_3100.v +++ b/test-suite/bugs/closed/bug_3100.v @@ -7,3 +7,4 @@ Fixpoint F (n : nat) (A : Type) : Type := Goal forall A n, (forall (x : A) (e : x = x), F n (e = e)). intros A n. Fail change (forall x, F n (x = x)) with (F (S n)). +Abort. diff --git a/test-suite/bugs/closed/bug_3199.v b/test-suite/bugs/closed/bug_3199.v index 08bf62493d..d1bd9017c1 100644 --- a/test-suite/bugs/closed/bug_3199.v +++ b/test-suite/bugs/closed/bug_3199.v @@ -16,3 +16,4 @@ Defined. Goal True. pose (e := eq_refl (qux 0)); unfold qux in e. match type of e with context [eq_sym] => fail 1 | _ => idtac end. +Abort. diff --git a/test-suite/bugs/closed/bug_3210.v b/test-suite/bugs/closed/bug_3210.v index bb673f38c2..b320c59d0f 100644 --- a/test-suite/bugs/closed/bug_3210.v +++ b/test-suite/bugs/closed/bug_3210.v @@ -20,3 +20,4 @@ match goal with |- I = I => idtac end. (* check form of the goal *) Undo 2. destruct x. match goal with |- I = I => idtac end. (* check form of the goal *) +Abort. diff --git a/test-suite/bugs/closed/bug_3228.v b/test-suite/bugs/closed/bug_3228.v index 5d1a0ff88b..7c0eba6e71 100644 --- a/test-suite/bugs/closed/bug_3228.v +++ b/test-suite/bugs/closed/bug_3228.v @@ -5,3 +5,4 @@ Ltac bar x := exact x. Goal False -> False. intro x. Fail bar doesnotexist. +Abort. diff --git a/test-suite/bugs/closed/bug_3251.v b/test-suite/bugs/closed/bug_3251.v index d4ce050c57..ef279688aa 100644 --- a/test-suite/bugs/closed/bug_3251.v +++ b/test-suite/bugs/closed/bug_3251.v @@ -12,3 +12,4 @@ Undo. Ltac foo := idtac. (* Before 5b39c3535f7b3383d89d7b844537244a4e7c0eca, this would print out: *) (* Anomaly: Backtrack.backto to a state with no vcs_backup. Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3257.v b/test-suite/bugs/closed/bug_3257.v index d8aa6a0479..88e2e71911 100644 --- a/test-suite/bugs/closed/bug_3257.v +++ b/test-suite/bugs/closed/bug_3257.v @@ -3,3 +3,4 @@ Lemma foo A B (P : B -> Prop) : pointwise_relation _ impl (fun z => A -> P z) P. Proof. Fail reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_3258.v b/test-suite/bugs/closed/bug_3258.v index b263c6baf4..946aff7d08 100644 --- a/test-suite/bugs/closed/bug_3258.v +++ b/test-suite/bugs/closed/bug_3258.v @@ -34,3 +34,4 @@ Proof. Undo. (* This failed with NotConvertible at some time *) setoid_rewrite (@remove_forall_eq' _ _ _). +Abort. diff --git a/test-suite/bugs/closed/bug_3260.v b/test-suite/bugs/closed/bug_3260.v index 9f0231d91b..f07f449b12 100644 --- a/test-suite/bugs/closed/bug_3260.v +++ b/test-suite/bugs/closed/bug_3260.v @@ -5,3 +5,4 @@ replace n with m at 2. lazymatch goal with |- n + m = m + m => idtac end. +Abort. diff --git a/test-suite/bugs/closed/bug_3262.v b/test-suite/bugs/closed/bug_3262.v index 70bfde2990..41b2c92281 100644 --- a/test-suite/bugs/closed/bug_3262.v +++ b/test-suite/bugs/closed/bug_3262.v @@ -76,3 +76,5 @@ Section hlist. | hlist_eqv_cons l ls x y h1 h2 pf pf' => _ end). + Abort. +End hlist. diff --git a/test-suite/bugs/closed/bug_3284.v b/test-suite/bugs/closed/bug_3284.v index 34cd09c6f4..854889e61e 100644 --- a/test-suite/bugs/closed/bug_3284.v +++ b/test-suite/bugs/closed/bug_3284.v @@ -21,3 +21,4 @@ Proof. intros A B C f g x H. specialize (H x). apply functional_extensionality_dep in H. +Abort. diff --git a/test-suite/bugs/closed/bug_3286.v b/test-suite/bugs/closed/bug_3286.v index 701480fc83..360a304a47 100644 --- a/test-suite/bugs/closed/bug_3286.v +++ b/test-suite/bugs/closed/bug_3286.v @@ -39,3 +39,4 @@ Proof. let lem := constr:(@functional_extensionality_dep) in apply_under_binders_in lem H. (* Anomaly: Uncaught exception Not_found(_). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3291.v b/test-suite/bugs/closed/bug_3291.v index 4ea748c0fb..19586abbfe 100644 --- a/test-suite/bugs/closed/bug_3291.v +++ b/test-suite/bugs/closed/bug_3291.v @@ -7,3 +7,4 @@ rewrite -> eq. auto. Set Typeclasses Debug. Fail setoid_rewrite <- H. (* The command has indeed failed with message: => Stack overflow. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3297.v b/test-suite/bugs/closed/bug_3297.v index 1cacb97ff3..da8390c475 100644 --- a/test-suite/bugs/closed/bug_3297.v +++ b/test-suite/bugs/closed/bug_3297.v @@ -10,3 +10,4 @@ Error: Abstracting over the term "n" leads to a term intro. clearbody H. subst. (* success *) +Abort. diff --git a/test-suite/bugs/closed/bug_3310.v b/test-suite/bugs/closed/bug_3310.v index d6c31c6b41..339280b2f2 100644 --- a/test-suite/bugs/closed/bug_3310.v +++ b/test-suite/bugs/closed/bug_3310.v @@ -9,3 +9,4 @@ Lemma id_spec : forall A (s : stream A), id s = s. Proof. intros A s. Fail change (id s) with (cons (hd (id s)) (tl (id s))). +Abort. diff --git a/test-suite/bugs/closed/bug_3319.v b/test-suite/bugs/closed/bug_3319.v index 0b0aff29cb..9a9eac26c4 100644 --- a/test-suite/bugs/closed/bug_3319.v +++ b/test-suite/bugs/closed/bug_3319.v @@ -24,3 +24,4 @@ Section precategory. Proof. admit. Defined. +End precategory. diff --git a/test-suite/bugs/closed/bug_3320.v b/test-suite/bugs/closed/bug_3320.v index a5c243d8e3..200c63b15c 100644 --- a/test-suite/bugs/closed/bug_3320.v +++ b/test-suite/bugs/closed/bug_3320.v @@ -3,3 +3,4 @@ Goal forall x : nat, True. assumption. Fail Qed. Undo. +Abort. diff --git a/test-suite/bugs/closed/bug_3321.v b/test-suite/bugs/closed/bug_3321.v index b6f10e533e..0718cd1257 100644 --- a/test-suite/bugs/closed/bug_3321.v +++ b/test-suite/bugs/closed/bug_3321.v @@ -17,3 +17,4 @@ intros. clear. try exists (path_universe admit). (* Toplevel input, characters 15-44: Anomaly: Uncaught exception Not_found(_). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3322.v b/test-suite/bugs/closed/bug_3322.v index ab3025a6aa..eb391042dd 100644 --- a/test-suite/bugs/closed/bug_3322.v +++ b/test-suite/bugs/closed/bug_3322.v @@ -22,3 +22,5 @@ Section opposite. Transparent path_sigma_uncurried. (* This command should fail with "Error: Failed to progress.", as it does in 8.4; the simpl never directive should prevent simpl from progressing *) Fail progress simpl in *. + Abort. +End opposite. diff --git a/test-suite/bugs/closed/bug_3323.v b/test-suite/bugs/closed/bug_3323.v index 4622634eaa..e81af07241 100644 --- a/test-suite/bugs/closed/bug_3323.v +++ b/test-suite/bugs/closed/bug_3323.v @@ -76,3 +76,4 @@ Error: In pattern-matching on term "x" the branch for constructor p2f (f2p (existT (fun I : Type => I -> A) x H)) = existT (fun I : Type => I -> A) x H". *) +End AssumeFunext. diff --git a/test-suite/bugs/closed/bug_3326.v b/test-suite/bugs/closed/bug_3326.v index f0d8cbf704..1c12685353 100644 --- a/test-suite/bugs/closed/bug_3326.v +++ b/test-suite/bugs/closed/bug_3326.v @@ -17,3 +17,4 @@ Proof. clear. Fail apply aLeqRefl. Abort. +End XXX. diff --git a/test-suite/bugs/closed/bug_3331.v b/test-suite/bugs/closed/bug_3331.v index 8594e45504..8047fc386b 100644 --- a/test-suite/bugs/closed/bug_3331.v +++ b/test-suite/bugs/closed/bug_3331.v @@ -29,3 +29,4 @@ Section groupoid_category. Set Typeclasses Debug. pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). Abort. +End groupoid_category. diff --git a/test-suite/bugs/closed/bug_3337.v b/test-suite/bugs/closed/bug_3337.v index cd7891f112..f8cfe985a9 100644 --- a/test-suite/bugs/closed/bug_3337.v +++ b/test-suite/bugs/closed/bug_3337.v @@ -2,3 +2,4 @@ Require Import Setoid. Goal forall x y : Set, x = y -> x = y. intros x y H. rewrite_strat subterms H. +Abort. diff --git a/test-suite/bugs/closed/bug_3338.v b/test-suite/bugs/closed/bug_3338.v index 076cd5e6ea..57160503d4 100644 --- a/test-suite/bugs/closed/bug_3338.v +++ b/test-suite/bugs/closed/bug_3338.v @@ -2,3 +2,4 @@ Require Import Setoid. Goal forall x y : Set, x = y -> y = y. intros x y H. rewrite_strat try topdown terms H. +Abort. diff --git a/test-suite/bugs/closed/bug_3372.v b/test-suite/bugs/closed/bug_3372.v index 91e3df76dd..eb70149a02 100644 --- a/test-suite/bugs/closed/bug_3372.v +++ b/test-suite/bugs/closed/bug_3372.v @@ -5,3 +5,4 @@ Fail exact hProp@{Set}. (* test that it fails, but is not an anomaly *) try (exact hProp@{Set}; fail 1). (* Toplevel input, characters 15-32: Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3383.v b/test-suite/bugs/closed/bug_3383.v index 25257644a6..b09b898adb 100644 --- a/test-suite/bugs/closed/bug_3383.v +++ b/test-suite/bugs/closed/bug_3383.v @@ -4,3 +4,4 @@ lazymatch goal with | [ |- context[match ?b as b' in bool return @?P b' with true => ?t | false => ?f end] ] => change (match b as b' in bool return P b' with true => t | false => f end) with (@bool_rect P t f b) end. +Abort. diff --git a/test-suite/bugs/closed/bug_3386.v b/test-suite/bugs/closed/bug_3386.v index b8bb8bce09..74a7d1796c 100644 --- a/test-suite/bugs/closed/bug_3386.v +++ b/test-suite/bugs/closed/bug_3386.v @@ -15,3 +15,4 @@ Proof. try change Type@{i} with (Obj set_cat@{i}). (* check that it's not an anomaly *) (* Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3390.v b/test-suite/bugs/closed/bug_3390.v index eb3c4f4b9c..f4e405de72 100644 --- a/test-suite/bugs/closed/bug_3390.v +++ b/test-suite/bugs/closed/bug_3390.v @@ -7,3 +7,4 @@ Tactic Notation "basicapply" tactic0(tacfin) := idtac. Goal True. basicapply subst. +Abort. diff --git a/test-suite/bugs/closed/bug_3393.v b/test-suite/bugs/closed/bug_3393.v index ae8e41e29e..d2eb61e3e2 100644 --- a/test-suite/bugs/closed/bug_3393.v +++ b/test-suite/bugs/closed/bug_3393.v @@ -151,3 +151,5 @@ Unable to unify morphism := NaturalTransformation (D:=F z); compose := composet (D:=F z); associativity := associativityt (D:=F z) |}". *) + Abort. +End lemmas. diff --git a/test-suite/bugs/closed/bug_3427.v b/test-suite/bugs/closed/bug_3427.v index 9a57ca7703..317efb0b32 100644 --- a/test-suite/bugs/closed/bug_3427.v +++ b/test-suite/bugs/closed/bug_3427.v @@ -194,3 +194,5 @@ instead of (fun x0 : setT (* Top.405 *) X0 => @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit". *) + Abort. +End AssumingUA. diff --git a/test-suite/bugs/closed/bug_3441.v b/test-suite/bugs/closed/bug_3441.v index d48c059acb..52acb996f8 100644 --- a/test-suite/bugs/closed/bug_3441.v +++ b/test-suite/bugs/closed/bug_3441.v @@ -21,3 +21,4 @@ Timeout 1 Time let H := fresh "H" in let x := constr:(let n := 17 in do_n n = do_n n) in let y := (eval lazy in x) in assert (H := y). (* Finished transaction in 1.19 secs (1.164u,0.024s) (successful) *) +Abort. diff --git a/test-suite/bugs/closed/bug_3461.v b/test-suite/bugs/closed/bug_3461.v index 1885568bd2..cad28a558c 100644 --- a/test-suite/bugs/closed/bug_3461.v +++ b/test-suite/bugs/closed/bug_3461.v @@ -3,3 +3,4 @@ Lemma foo (b : bool) : Proof. eexists. Fail eexact (eq_refl b). +Abort. diff --git a/test-suite/bugs/closed/bug_3469.v b/test-suite/bugs/closed/bug_3469.v index 6aa3b56f8b..b43e65ab83 100644 --- a/test-suite/bugs/closed/bug_3469.v +++ b/test-suite/bugs/closed/bug_3469.v @@ -27,3 +27,4 @@ Proof. (* Toplevel input, characters 21-31: Error: Found no subterm matching "proj1_sig ?206" in the current *) +Abort. diff --git a/test-suite/bugs/closed/bug_3477.v b/test-suite/bugs/closed/bug_3477.v index 3ed63604ea..0690c22670 100644 --- a/test-suite/bugs/closed/bug_3477.v +++ b/test-suite/bugs/closed/bug_3477.v @@ -7,3 +7,4 @@ Proof. evar (a : prod A B); evar (f : (prod A B -> Set)). let a' := (eval unfold a in a) in set(foo:=eq_refl : a' = (@pair _ _ (fst a') (snd a'))). +Abort. diff --git a/test-suite/bugs/closed/bug_3480.v b/test-suite/bugs/closed/bug_3480.v index 35e0c51a93..fd98232f96 100644 --- a/test-suite/bugs/closed/bug_3480.v +++ b/test-suite/bugs/closed/bug_3480.v @@ -46,3 +46,5 @@ x : xa <~=~> yb The term "morphism_isomorphic:@morphism (precategory_of_structures P) xa yb" has type "@morphism (precategory_of_structures P) xa yb" while it is expected to have type "morphism ?40 ?41 ?42". *) + Abort. +End sip. diff --git a/test-suite/bugs/closed/bug_3495.v b/test-suite/bugs/closed/bug_3495.v index 102a2aba0d..7b0883f910 100644 --- a/test-suite/bugs/closed/bug_3495.v +++ b/test-suite/bugs/closed/bug_3495.v @@ -16,3 +16,4 @@ let e := match goal with |- R ?e _ => constr:(e) end in unify e (a (default_foo True)). subst b. reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_3513.v b/test-suite/bugs/closed/bug_3513.v index f17fb2d9d0..462a615d91 100644 --- a/test-suite/bugs/closed/bug_3513.v +++ b/test-suite/bugs/closed/bug_3513.v @@ -71,3 +71,4 @@ Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) Focus 2. (* As in 8.5, allow a shelved subgoal to remain *) apply reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_3539.v b/test-suite/bugs/closed/bug_3539.v index b0c4b23702..3796a7b308 100644 --- a/test-suite/bugs/closed/bug_3539.v +++ b/test-suite/bugs/closed/bug_3539.v @@ -64,3 +64,4 @@ m : T3 (x' fst1 x2) (x' fst0 x2) Unable to unify "?25 (@pair ?23 ?24 (fst ?27) (snd ?27))" with "?25 ?27". *) +Abort. diff --git a/test-suite/bugs/closed/bug_3542.v b/test-suite/bugs/closed/bug_3542.v index b6837a0c33..e9a8460622 100644 --- a/test-suite/bugs/closed/bug_3542.v +++ b/test-suite/bugs/closed/bug_3542.v @@ -4,3 +4,5 @@ Section foo. Goal True. pose (r := fun k => existT (fun g => forall x, f x = g x) (fun x => projT1 (k x)) (fun x => projT2 (k x))). + Abort. +End foo. diff --git a/test-suite/bugs/closed/bug_3546.v b/test-suite/bugs/closed/bug_3546.v index 55d718bd03..88724a52fc 100644 --- a/test-suite/bugs/closed/bug_3546.v +++ b/test-suite/bugs/closed/bug_3546.v @@ -15,3 +15,4 @@ z : Set w : Set Unable to unify "?31 ?191 = ?32 ?192" with "(x, y) = (z, w)". *) +Abort. diff --git a/test-suite/bugs/closed/bug_3554.v b/test-suite/bugs/closed/bug_3554.v index 13a79cc840..2c88b79bc8 100644 --- a/test-suite/bugs/closed/bug_3554.v +++ b/test-suite/bugs/closed/bug_3554.v @@ -1 +1,2 @@ Example foo (f : forall {_ : Type}, Type) : Type. +Abort. diff --git a/test-suite/bugs/closed/bug_3561.v b/test-suite/bugs/closed/bug_3561.v index 06ffef6829..7485c697f2 100644 --- a/test-suite/bugs/closed/bug_3561.v +++ b/test-suite/bugs/closed/bug_3561.v @@ -22,3 +22,4 @@ Goal forall (H0 H2 : Type) x p, match goal with | [ |- context[x (?f _)] ] => set(foo':=f) end. +Abort. diff --git a/test-suite/bugs/closed/bug_3562.v b/test-suite/bugs/closed/bug_3562.v index 1a1410a3b1..bdb3fcb65f 100644 --- a/test-suite/bugs/closed/bug_3562.v +++ b/test-suite/bugs/closed/bug_3562.v @@ -4,3 +4,4 @@ Theorem t: True. Fail destruct 0 as x. +Abort. diff --git a/test-suite/bugs/closed/bug_3563.v b/test-suite/bugs/closed/bug_3563.v index 961563ed4a..f6a84933b7 100644 --- a/test-suite/bugs/closed/bug_3563.v +++ b/test-suite/bugs/closed/bug_3563.v @@ -36,3 +36,4 @@ Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> (H1 -> H) * H0) (* Anomaly: Uncaught exception Not_found(_). Please report. *) (* Anomaly: Uncaught exception Not_found(_). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3566.v b/test-suite/bugs/closed/bug_3566.v index 84743e48f6..1255f0640f 100644 --- a/test-suite/bugs/closed/bug_3566.v +++ b/test-suite/bugs/closed/bug_3566.v @@ -21,3 +21,4 @@ Goal forall x y : Type, x = y. intros. pose proof ((fun H0 : idmap _ => (@path_universe _ _ (@lift x) (H0 x) @ (@path_universe _ _ (@lift x) (H0 x))^)))%path as H''. +Abort. diff --git a/test-suite/bugs/closed/bug_3567.v b/test-suite/bugs/closed/bug_3567.v index 00c9c05469..be05bb9453 100644 --- a/test-suite/bugs/closed/bug_3567.v +++ b/test-suite/bugs/closed/bug_3567.v @@ -66,3 +66,4 @@ which is ill-typed. Reason is: Pattern-matching expression on an object of inductive type prod has invalid information. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3612.v b/test-suite/bugs/closed/bug_3612.v index 33e5d532ad..b6dcd55346 100644 --- a/test-suite/bugs/closed/bug_3612.v +++ b/test-suite/bugs/closed/bug_3612.v @@ -52,3 +52,4 @@ Goal forall (A : Type) (B : forall _ : A, Type) (x : @sigT A (fun x : A => B x)) pose (path_path_sigma B x x xx) as x''. clear x''. Check (path_path_sigma B x x xx). +Abort. diff --git a/test-suite/bugs/closed/bug_3616.v b/test-suite/bugs/closed/bug_3616.v index 688700260c..bb501f158c 100644 --- a/test-suite/bugs/closed/bug_3616.v +++ b/test-suite/bugs/closed/bug_3616.v @@ -1,3 +1,4 @@ (* Was failing from April 2014 to September 2014 because of injection *) Goal forall P e es t, (e :: es = existT P tt t :: es)%list -> True. inversion 1. +Abort. diff --git a/test-suite/bugs/closed/bug_3638.v b/test-suite/bugs/closed/bug_3638.v index 4f1fcfecd3..4545738837 100644 --- a/test-suite/bugs/closed/bug_3638.v +++ b/test-suite/bugs/closed/bug_3638.v @@ -23,3 +23,4 @@ Goal forall (A B : Type) (x : O A * O B) (x0 : B), (* Toplevel input, characters 15-114: Anomaly: Bad recursive type. Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3640.v b/test-suite/bugs/closed/bug_3640.v index 5dff98ba23..d0d634bea5 100644 --- a/test-suite/bugs/closed/bug_3640.v +++ b/test-suite/bugs/closed/bug_3640.v @@ -29,3 +29,4 @@ Proof. Fail match type of H with | _ = negb ?T => unify T (f.1 true); fail 1 "still has f.1 true" end. (* Error: Tactic failure: still has f.1 true. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3641.v b/test-suite/bugs/closed/bug_3641.v index 730ab3f431..eefec04851 100644 --- a/test-suite/bugs/closed/bug_3641.v +++ b/test-suite/bugs/closed/bug_3641.v @@ -19,3 +19,4 @@ Goal forall (A B : Type) (x : O A * O B) (x0 : B), | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in pose (e' := e) end. Fail change ?g with e'. (* Stack overflow *) +Abort. diff --git a/test-suite/bugs/closed/bug_3647.v b/test-suite/bugs/closed/bug_3647.v index e91c004c77..80dd99709a 100644 --- a/test-suite/bugs/closed/bug_3647.v +++ b/test-suite/bugs/closed/bug_3647.v @@ -652,3 +652,4 @@ Goal forall (ptest : program) (cond : Condition) (value : bool) subst_body; simpl. Fail refine (all_behead (projT2 _)). Unset Solve Unification Constraints. refine (all_behead (projT2 _)). +Abort. diff --git a/test-suite/bugs/closed/bug_3648.v b/test-suite/bugs/closed/bug_3648.v index 58aa161403..ec13115102 100644 --- a/test-suite/bugs/closed/bug_3648.v +++ b/test-suite/bugs/closed/bug_3648.v @@ -81,3 +81,4 @@ Found no subterm matching "F _1 (identity (fst x))" in the current goal. *) rewrite identity_of. (* Toplevel input, characters 15-34: Error: Found no subterm matching "morphism_of ?202 (identity ?203)" in the current goal. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3649.v b/test-suite/bugs/closed/bug_3649.v index a664a1ef1d..2f907ccc32 100644 --- a/test-suite/bugs/closed/bug_3649.v +++ b/test-suite/bugs/closed/bug_3649.v @@ -58,3 +58,4 @@ Goal forall (C D : PreCategory) (G G' : Functor C D) let T0 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T0) end in let T1 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T1) end in progress change (T0 x o T1 x) with ((fun y => y) (T0 x o T1 x)). +Abort. diff --git a/test-suite/bugs/closed/bug_3656.v b/test-suite/bugs/closed/bug_3656.v index fb92e11630..cf32cac09d 100644 --- a/test-suite/bugs/closed/bug_3656.v +++ b/test-suite/bugs/closed/bug_3656.v @@ -51,3 +51,4 @@ Abort. Goal forall h, setT h = setT h. Proof. intro. progress unfold setT. +Abort. diff --git a/test-suite/bugs/closed/bug_3657.v b/test-suite/bugs/closed/bug_3657.v index 778fdab190..49c334e620 100644 --- a/test-suite/bugs/closed/bug_3657.v +++ b/test-suite/bugs/closed/bug_3657.v @@ -10,3 +10,4 @@ Defined. Goal @bar _ Set _ = (@bar _ (fun _ : Set => Set) _) nat. Proof. Fail change (bar (fun _ : Set => Set)) with (bar Set). +Abort. diff --git a/test-suite/bugs/closed/bug_3660.v b/test-suite/bugs/closed/bug_3660.v index be693886e6..f00ffef9e9 100644 --- a/test-suite/bugs/closed/bug_3660.v +++ b/test-suite/bugs/closed/bug_3660.v @@ -26,3 +26,4 @@ Goal forall (C D : hSet), IsEquiv (fun x : C = D => (equiv_path C D (ap setT x)) apply @isequiv_compose; [ | admit ]. Set Typeclasses Debug. typeclasses eauto. +Abort. diff --git a/test-suite/bugs/closed/bug_3661.v b/test-suite/bugs/closed/bug_3661.v index 1f13ffcf34..e040c9d39f 100644 --- a/test-suite/bugs/closed/bug_3661.v +++ b/test-suite/bugs/closed/bug_3661.v @@ -86,3 +86,4 @@ Goal forall (x3 x9 : PreCategory) (x12 f0 : Functor x9 x3) (@morphism_isomorphic (functor_category x9 x3) f0 x12 x35) _) x37) *) +Abort. diff --git a/test-suite/bugs/closed/bug_3667.v b/test-suite/bugs/closed/bug_3667.v index 14a641f018..a0c112e7cc 100644 --- a/test-suite/bugs/closed/bug_3667.v +++ b/test-suite/bugs/closed/bug_3667.v @@ -21,3 +21,4 @@ Goal forall (A : PreCategory) (F : Functor A set_cat) (a : A) (x : F a) (nt :NaturalTransformation F F), x = x. intros. pose (fun c d m => ap10 (commutes nt c d m)). +Abort. diff --git a/test-suite/bugs/closed/bug_3670.v b/test-suite/bugs/closed/bug_3670.v index a4d5978b48..bdf4550a76 100644 --- a/test-suite/bugs/closed/bug_3670.v +++ b/test-suite/bugs/closed/bug_3670.v @@ -21,3 +21,4 @@ Module BAR_FROM_BAZ (baz : BAZ) <: BAR. Admitted. Fail End BAR_FROM_BAZ. +Reset BAR_FROM_BAZ. diff --git a/test-suite/bugs/closed/bug_3675.v b/test-suite/bugs/closed/bug_3675.v index 93227ab852..529c1504cf 100644 --- a/test-suite/bugs/closed/bug_3675.v +++ b/test-suite/bugs/closed/bug_3675.v @@ -18,3 +18,4 @@ Proof. (compose g f) (compose f^-1 g^-1) _). exact (fun c => ap g (@eisretr _ _ f _ (g^-1 c)) @ (@eisretr _ _ g _ c)). +Abort. diff --git a/test-suite/bugs/closed/bug_3685.v b/test-suite/bugs/closed/bug_3685.v index 7a0c3e6f1d..5d91d84d98 100644 --- a/test-suite/bugs/closed/bug_3685.v +++ b/test-suite/bugs/closed/bug_3685.v @@ -73,3 +73,4 @@ Module Bad. object_of (fun CD C'D' FG => pointwise (fst FG) (snd FG)) (fun _ _ => @Pidentity_of _ _ _ _). +End Bad. diff --git a/test-suite/bugs/closed/bug_3698.v b/test-suite/bugs/closed/bug_3698.v index 3882eee97c..21978b7108 100644 --- a/test-suite/bugs/closed/bug_3698.v +++ b/test-suite/bugs/closed/bug_3698.v @@ -24,3 +24,4 @@ Proof. g = g -> IsEquiv g) by admit. Eval compute in (@projT1 Type IsHSet (@equiv_inv _ _ _ (equiv_isequiv _ _ issig_hSet) X)). Fail apply H''. (* stack overflow *) +Abort. diff --git a/test-suite/bugs/closed/bug_3709.v b/test-suite/bugs/closed/bug_3709.v index 815f5b9507..680a81da9e 100644 --- a/test-suite/bugs/closed/bug_3709.v +++ b/test-suite/bugs/closed/bug_3709.v @@ -22,3 +22,5 @@ Module Prim. intros h k f H. etransitivity. apply H. + Abort. +End Prim. diff --git a/test-suite/bugs/closed/bug_3710.v b/test-suite/bugs/closed/bug_3710.v index b9e2798d88..07208ffa87 100644 --- a/test-suite/bugs/closed/bug_3710.v +++ b/test-suite/bugs/closed/bug_3710.v @@ -46,3 +46,4 @@ Local Notation cat := (@sub_pre_cat P). Goal forall (s d d' : cat) (m1 : morphism cat d d') (m2 : morphism cat s d), NaturalIsomorphism (m1 o m2) (m1 o m2)%functor. Fail exact (fun _ _ _ _ _ => reflexivity _). +Abort. diff --git a/test-suite/bugs/closed/bug_3755.v b/test-suite/bugs/closed/bug_3755.v index f0b542d31e..5485a0f8cf 100644 --- a/test-suite/bugs/closed/bug_3755.v +++ b/test-suite/bugs/closed/bug_3755.v @@ -14,3 +14,4 @@ Section param. @STex _ (fun x => P (@existT _ _ v x)). Check @existT _ _ STex STex. +End param. diff --git a/test-suite/bugs/closed/bug_3777.v b/test-suite/bugs/closed/bug_3777.v index e203528fcc..9ca36cdd9f 100644 --- a/test-suite/bugs/closed/bug_3777.v +++ b/test-suite/bugs/closed/bug_3777.v @@ -15,3 +15,4 @@ Module WithPoly. Definition foo (A : Type@{i}) (B : Type@{i}) := A -> B. Set Printing Universes. Fail Check ((@foo : Set -> _ -> _) : _ -> Type -> _). +End WithPoly. diff --git a/test-suite/bugs/closed/bug_3815.v b/test-suite/bugs/closed/bug_3815.v index 5fb4839847..a89f9ac307 100644 --- a/test-suite/bugs/closed/bug_3815.v +++ b/test-suite/bugs/closed/bug_3815.v @@ -7,3 +7,4 @@ Theorem t {A B C D} (f : A -> A) (g : B -> C) (h : C -> D) : f ∘ f = f. Proof. rewrite_strat topdown (hints core). +Abort. diff --git a/test-suite/bugs/closed/bug_3828.v b/test-suite/bugs/closed/bug_3828.v index ae11c6c96c..3c01dfd734 100644 --- a/test-suite/bugs/closed/bug_3828.v +++ b/test-suite/bugs/closed/bug_3828.v @@ -1,2 +1,3 @@ Goal 0 = 0. Fail pose ?Goal. +Abort. diff --git a/test-suite/bugs/closed/bug_3849.v b/test-suite/bugs/closed/bug_3849.v index a8dc3af9cf..bde75afa69 100644 --- a/test-suite/bugs/closed/bug_3849.v +++ b/test-suite/bugs/closed/bug_3849.v @@ -6,3 +6,4 @@ Goal True. do 5 pose proof 0 as ?n0. foo n1 n2. bar n3 n4. +Abort. diff --git a/test-suite/bugs/closed/bug_3854.v b/test-suite/bugs/closed/bug_3854.v index 7e915f202b..877e4ba48b 100644 --- a/test-suite/bugs/closed/bug_3854.v +++ b/test-suite/bugs/closed/bug_3854.v @@ -20,3 +20,4 @@ Proof. pose (fun x => BuildhProp (~ mem x x)). refine (mem_induction (fun x => BuildhProp (~ mem x x)) _); simpl in *. admit. +Abort. diff --git a/test-suite/bugs/closed/bug_3895.v b/test-suite/bugs/closed/bug_3895.v index 8659ca2cbd..53fd6b2da2 100644 --- a/test-suite/bugs/closed/bug_3895.v +++ b/test-suite/bugs/closed/bug_3895.v @@ -20,3 +20,4 @@ Proof. change g with ((snd o pr1) o e). apply (ap (fun g => snd o pr1 o g)). (* Used to raise a not Found due to a "typo" in solve_evar_evar *) +Abort. diff --git a/test-suite/bugs/closed/bug_3896.v b/test-suite/bugs/closed/bug_3896.v index b433922a21..5ccc9c5d3a 100644 --- a/test-suite/bugs/closed/bug_3896.v +++ b/test-suite/bugs/closed/bug_3896.v @@ -2,3 +2,4 @@ Goal True. pose proof 0 as n. Fail apply pair in n. (* Used to be an anomaly for a while *) +Abort. diff --git a/test-suite/bugs/closed/bug_3920.v b/test-suite/bugs/closed/bug_3920.v index a4adb23cc2..25a76242ba 100644 --- a/test-suite/bugs/closed/bug_3920.v +++ b/test-suite/bugs/closed/bug_3920.v @@ -5,3 +5,4 @@ Lemma foo (H : P 3) : False. eapply or_introl in H. erewrite <- P_or in H. (* Error: No such hypothesis: H *) +Abort. diff --git a/test-suite/bugs/closed/bug_3922.v b/test-suite/bugs/closed/bug_3922.v index d88e8c3325..6e982f8103 100644 --- a/test-suite/bugs/closed/bug_3922.v +++ b/test-suite/bugs/closed/bug_3922.v @@ -83,3 +83,4 @@ Proof. refine (let g' := Trunc_ind (fun _ => P) g : merely X -> P in _); [ assumption.. | ]. pose (g'' := Trunc_ind (fun _ => P) g : merely X -> P). +Abort. diff --git a/test-suite/bugs/closed/bug_3938.v b/test-suite/bugs/closed/bug_3938.v index 35db82bd4c..a27600957a 100644 --- a/test-suite/bugs/closed/bug_3938.v +++ b/test-suite/bugs/closed/bug_3938.v @@ -6,3 +6,4 @@ Goal forall a b (f : nat -> Set) (R : nat -> nat -> Prop), Equivalence R -> R a b -> f a = f b. intros a b f H. intros. Fail rewrite H1. +Abort. diff --git a/test-suite/bugs/closed/bug_3943.v b/test-suite/bugs/closed/bug_3943.v index ac9c50369b..151a6ea275 100644 --- a/test-suite/bugs/closed/bug_3943.v +++ b/test-suite/bugs/closed/bug_3943.v @@ -48,3 +48,4 @@ Admitted. Definition ap_morphism_inverse_path_isomorphic (i j : Isomorphic s d) p q : ap (fun e : Isomorphic s d => e^-1)%morphism (path_isomorphic i j p) = q. +Abort. diff --git a/test-suite/bugs/closed/bug_3944.v b/test-suite/bugs/closed/bug_3944.v index 58e60f4f2e..c9e9795d9e 100644 --- a/test-suite/bugs/closed/bug_3944.v +++ b/test-suite/bugs/closed/bug_3944.v @@ -3,3 +3,4 @@ Definition C (T : Type) := T. Goal forall T (i : C T) (v : T), True. Proof. Fail setoid_rewrite plus_n_Sm. +Abort. diff --git a/test-suite/bugs/closed/bug_3953.v b/test-suite/bugs/closed/bug_3953.v index 167cecea8e..f473f63545 100644 --- a/test-suite/bugs/closed/bug_3953.v +++ b/test-suite/bugs/closed/bug_3953.v @@ -3,3 +3,4 @@ Goal forall (a b : unit), a = b -> exists c, b = c. intros. eexists. subst. +Abort. diff --git a/test-suite/bugs/closed/bug_3974.v b/test-suite/bugs/closed/bug_3974.v index 3d9e06b612..b166e73fa1 100644 --- a/test-suite/bugs/closed/bug_3974.v +++ b/test-suite/bugs/closed/bug_3974.v @@ -5,3 +5,4 @@ Module Type M (X : S). Fail Module P (X : S). (* Used to say: Anomaly: X already exists. Please report. *) (* Should rather say now: Error: X already exists. *) +End M. diff --git a/test-suite/bugs/closed/bug_3975.v b/test-suite/bugs/closed/bug_3975.v index c7616b3ab6..afd35815df 100644 --- a/test-suite/bugs/closed/bug_3975.v +++ b/test-suite/bugs/closed/bug_3975.v @@ -6,3 +6,4 @@ Module Type P (X : S). Print M. (* Used to say: Anomaly: X already exists. Please report. *) (* Should rather : print something :-) *) +End P. diff --git a/test-suite/bugs/closed/bug_3993.v b/test-suite/bugs/closed/bug_3993.v index 086d8dd0f3..a1ab3bf615 100644 --- a/test-suite/bugs/closed/bug_3993.v +++ b/test-suite/bugs/closed/bug_3993.v @@ -1,3 +1,4 @@ (* Test smooth failure on not fully applied term to destruct with eqn: given *) Goal True. Fail induction S eqn:H. +Abort. diff --git a/test-suite/bugs/closed/bug_4018.v b/test-suite/bugs/closed/bug_4018.v index 8895e09e02..d7929372ad 100644 --- a/test-suite/bugs/closed/bug_4018.v +++ b/test-suite/bugs/closed/bug_4018.v @@ -1,3 +1,4 @@ (* Catching PatternMatchingFailure was lost at some point *) Goal nat -> True. Fail intros [=]. +Abort. diff --git a/test-suite/bugs/closed/bug_4034.v b/test-suite/bugs/closed/bug_4034.v index 3f7be4d1c7..5f1b60fc8d 100644 --- a/test-suite/bugs/closed/bug_4034.v +++ b/test-suite/bugs/closed/bug_4034.v @@ -23,3 +23,4 @@ Goal Foo. myexact !. Defined. *) +Abort. diff --git a/test-suite/bugs/closed/bug_4035.v b/test-suite/bugs/closed/bug_4035.v index ec246d097b..461a95e82d 100644 --- a/test-suite/bugs/closed/bug_4035.v +++ b/test-suite/bugs/closed/bug_4035.v @@ -11,3 +11,4 @@ Goal nat -> Type. lazymatch goal with | [ x : nat |- _ ] => dependent destruction x end. +Abort. diff --git a/test-suite/bugs/closed/bug_4057.v b/test-suite/bugs/closed/bug_4057.v index 5b2e56f261..f5889d253c 100644 --- a/test-suite/bugs/closed/bug_4057.v +++ b/test-suite/bugs/closed/bug_4057.v @@ -208,3 +208,4 @@ P (parse_of_item_name__of__minimal_parse_of_name p') }. simpl in *. admit. Qed. +End recursive_descent_parser. diff --git a/test-suite/bugs/closed/bug_4089.v b/test-suite/bugs/closed/bug_4089.v index fc1c504f14..38fbec0464 100644 --- a/test-suite/bugs/closed/bug_4089.v +++ b/test-suite/bugs/closed/bug_4089.v @@ -373,3 +373,4 @@ cannot be applied to the term This term has type "Type@{Top.892}" which should be coercible to "Type@{Top.882}". *) +Abort. diff --git a/test-suite/bugs/closed/bug_4095.v b/test-suite/bugs/closed/bug_4095.v index bc9380f90d..3d3015c383 100644 --- a/test-suite/bugs/closed/bug_4095.v +++ b/test-suite/bugs/closed/bug_4095.v @@ -85,3 +85,4 @@ tr : T -> T O2 : PointedOPred x0 : T H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0 *) +Abort. diff --git a/test-suite/bugs/closed/bug_4101.v b/test-suite/bugs/closed/bug_4101.v index b7c3e372aa..19e6f65805 100644 --- a/test-suite/bugs/closed/bug_4101.v +++ b/test-suite/bugs/closed/bug_4101.v @@ -17,3 +17,4 @@ Proof. intros. Set Debug Tactic Unification. apply path_forall. +Abort. diff --git a/test-suite/bugs/closed/bug_4103.v b/test-suite/bugs/closed/bug_4103.v index 92cc0279ac..690511a86c 100644 --- a/test-suite/bugs/closed/bug_4103.v +++ b/test-suite/bugs/closed/bug_4103.v @@ -10,3 +10,4 @@ Proof. (* Set Debug Tactic Unification. *) (* Set Debug RAKAM. *) reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_4116.v b/test-suite/bugs/closed/bug_4116.v index 5932c9c56e..17c7bbe5eb 100644 --- a/test-suite/bugs/closed/bug_4116.v +++ b/test-suite/bugs/closed/bug_4116.v @@ -381,3 +381,5 @@ Section Grothendieck2. destruct x. simpl. erewrite @isotoid_1. + Abort. +End Grothendieck2. diff --git a/test-suite/bugs/closed/bug_4151.v b/test-suite/bugs/closed/bug_4151.v index fc0b58cfe1..9ec8c01ac6 100644 --- a/test-suite/bugs/closed/bug_4151.v +++ b/test-suite/bugs/closed/bug_4151.v @@ -401,3 +401,5 @@ Section sound. assumption. Undo. eassumption. (* no applicable tactic *) + Abort. +End sound. diff --git a/test-suite/bugs/closed/bug_4165.v b/test-suite/bugs/closed/bug_4165.v index 8e0a62d35c..5333a0f6cf 100644 --- a/test-suite/bugs/closed/bug_4165.v +++ b/test-suite/bugs/closed/bug_4165.v @@ -5,3 +5,4 @@ match eval cbv delta [s] in s with | context C[true] => let C':=context C[false] in pose C' as s' end. +Abort. diff --git a/test-suite/bugs/closed/bug_4187.v b/test-suite/bugs/closed/bug_4187.v index b13ca36a37..d729d1a287 100644 --- a/test-suite/bugs/closed/bug_4187.v +++ b/test-suite/bugs/closed/bug_4187.v @@ -244,6 +244,8 @@ Arguments productions _ : clear implicits. Arguments grammar _ : clear implicits. End ContextFreeGrammar. +End Parsers. +End ADTSynthesis. Module Export BaseTypes. @@ -707,3 +709,6 @@ Section implementation. G'. intros str G'. Timeout 1 assert (pf' : G' -> Prop) by abstract admit. + Abort. +End implementation. +End BooleanRecognizer. diff --git a/test-suite/bugs/closed/bug_4190.v b/test-suite/bugs/closed/bug_4190.v index 2843488ba0..7e975587f6 100644 --- a/test-suite/bugs/closed/bug_4190.v +++ b/test-suite/bugs/closed/bug_4190.v @@ -13,3 +13,6 @@ Module Type F (Import M : C). Lemma foo : True. Proof. bar. +Abort. + +End F. diff --git a/test-suite/bugs/closed/bug_4205.v b/test-suite/bugs/closed/bug_4205.v index c40dfcc1f3..b6cf214cf9 100644 --- a/test-suite/bugs/closed/bug_4205.v +++ b/test-suite/bugs/closed/bug_4205.v @@ -6,3 +6,4 @@ Inductive test : nat -> nat -> nat -> nat -> Prop := Goal test 1 2 3 4. erewrite f_equal2 with (f := fun k l => test _ _ k l). +Abort. diff --git a/test-suite/bugs/closed/bug_4216.v b/test-suite/bugs/closed/bug_4216.v index 60b1311ace..5b4f3da160 100644 --- a/test-suite/bugs/closed/bug_4216.v +++ b/test-suite/bugs/closed/bug_4216.v @@ -17,3 +17,4 @@ Let T_pure_id `{TMonad T} {A: Type} (t: A -> A) (x: T A): path (T_fzip A A (T_pure (A -> A) t) x) x. unfold T_fzip, T_pure. Fail rewrite (ret_unit_left (fun g a => ret (g a)) (fun x => x)). +Abort. diff --git a/test-suite/bugs/closed/bug_4217.v b/test-suite/bugs/closed/bug_4217.v index 19973f30a7..af1fe2c755 100644 --- a/test-suite/bugs/closed/bug_4217.v +++ b/test-suite/bugs/closed/bug_4217.v @@ -4,3 +4,4 @@ Fixpoint ith_default {default_A : nat} {As : list nat} {struct As} : Set. +Abort. diff --git a/test-suite/bugs/closed/bug_4221.v b/test-suite/bugs/closed/bug_4221.v index bc120fb1ff..f433c85455 100644 --- a/test-suite/bugs/closed/bug_4221.v +++ b/test-suite/bugs/closed/bug_4221.v @@ -7,3 +7,4 @@ Goal (forall x : nat, x = 1 -> False) -> 1 = 1 -> False. | [ x : forall k : nat, _ |- _ ] => specialize (fun H0 => x 1 H0) end. +Abort. diff --git a/test-suite/bugs/closed/bug_4234.v b/test-suite/bugs/closed/bug_4234.v index 348dd49d93..0da4313063 100644 --- a/test-suite/bugs/closed/bug_4234.v +++ b/test-suite/bugs/closed/bug_4234.v @@ -5,3 +5,4 @@ Definition dirprodpair {X Y : UU} := existT (fun x : X => Y). Definition funtoprodtoprod {X Y Z : UU} : { a : X -> Y & X -> Z }. Proof. refine (dirprodpair _ (fun x => _)). +Abort. diff --git a/test-suite/bugs/closed/bug_4240.v b/test-suite/bugs/closed/bug_4240.v index 083c59fe68..0009844fb6 100644 --- a/test-suite/bugs/closed/bug_4240.v +++ b/test-suite/bugs/closed/bug_4240.v @@ -10,3 +10,4 @@ assert (H5 = new). unfold H5. unfold H1. exact (eq_refl new). +Abort. diff --git a/test-suite/bugs/closed/bug_4256.v b/test-suite/bugs/closed/bug_4256.v index 3e5438cd46..a88bd28aa9 100644 --- a/test-suite/bugs/closed/bug_4256.v +++ b/test-suite/bugs/closed/bug_4256.v @@ -41,3 +41,4 @@ Proof. clear H x0. (** But this doesn't: *) pose (existT (fun x:X => Trunc -1 (x = point X)) (point X) (tr idpath)). +Abort. diff --git a/test-suite/bugs/closed/bug_4284.v b/test-suite/bugs/closed/bug_4284.v index 0fff3026ff..167a562fe8 100644 --- a/test-suite/bugs/closed/bug_4284.v +++ b/test-suite/bugs/closed/bug_4284.v @@ -4,3 +4,4 @@ Theorem onefiber' {X : Type} (P : X -> Type) (x : X) : True. Proof. set (Q1 := total2 (fun f => pr1 P f = x)). set (f1:=fun q1 : Q1 => pr2 _ (pr1 _ q1)). +Abort. diff --git a/test-suite/bugs/closed/bug_4287.v b/test-suite/bugs/closed/bug_4287.v index 757b71b2dd..de97431520 100644 --- a/test-suite/bugs/closed/bug_4287.v +++ b/test-suite/bugs/closed/bug_4287.v @@ -4,7 +4,7 @@ Universe b. Universe c. -Definition U : Type@{b} := Type@{c}. +Definition UU : Type@{b} := Type@{c}. Module Type MT. @@ -17,6 +17,10 @@ Module M : MT. Print Universes. Fail End M. + Reset T. + Definition T := Prop. +End M. + Set Universe Polymorphism. (* This is a modified version of Hurkens with all universes floating *) diff --git a/test-suite/bugs/closed/bug_4299.v b/test-suite/bugs/closed/bug_4299.v index a1daa193ae..d4a2e19717 100644 --- a/test-suite/bugs/closed/bug_4299.v +++ b/test-suite/bugs/closed/bug_4299.v @@ -10,3 +10,4 @@ Module M : Foo with Definition U := Type : Type. Definition U := let X := Type in Type. Definition eq : Type = U := eq_refl. Fail End M. +Reset M. diff --git a/test-suite/bugs/closed/bug_4325.v b/test-suite/bugs/closed/bug_4325.v index af69ca04b6..de3e4bfa8c 100644 --- a/test-suite/bugs/closed/bug_4325.v +++ b/test-suite/bugs/closed/bug_4325.v @@ -3,3 +3,4 @@ Proof. clear. intro H. erewrite (fun H' => H _ H'). +Abort. diff --git a/test-suite/bugs/closed/bug_4347.v b/test-suite/bugs/closed/bug_4347.v index 29686a26c1..3f68444040 100644 --- a/test-suite/bugs/closed/bug_4347.v +++ b/test-suite/bugs/closed/bug_4347.v @@ -15,3 +15,4 @@ Record Demonstration := mkDemo Theorem DemoError : Demonstration. Fail apply mkDemo. (*Anomaly: Uncaught exception Not_found. Please report.*) +Abort. diff --git a/test-suite/bugs/closed/bug_4378.v b/test-suite/bugs/closed/bug_4378.v index 9d59165562..c50fd2c800 100644 --- a/test-suite/bugs/closed/bug_4378.v +++ b/test-suite/bugs/closed/bug_4378.v @@ -7,3 +7,4 @@ Tactic Notation "epose2" open_constr(a) tactic3(tac) := Goal True. epose _. Undo. epose2 _ idtac. +Abort. diff --git a/test-suite/bugs/closed/bug_4397.v b/test-suite/bugs/closed/bug_4397.v index 3566353d84..576e8186dd 100644 --- a/test-suite/bugs/closed/bug_4397.v +++ b/test-suite/bugs/closed/bug_4397.v @@ -1,3 +1,4 @@ Require Import Equality. Theorem foo (u : unit) (H : u = u) : True. dependent destruction H. +Abort. diff --git a/test-suite/bugs/closed/bug_4404.v b/test-suite/bugs/closed/bug_4404.v index 38fed1936c..4125ea1c1b 100644 --- a/test-suite/bugs/closed/bug_4404.v +++ b/test-suite/bugs/closed/bug_4404.v @@ -1,3 +1,4 @@ Inductive Foo : Type -> Type := foo A : Foo A. Goal True. remember Foo. +Abort. diff --git a/test-suite/bugs/closed/bug_4412.v b/test-suite/bugs/closed/bug_4412.v index 4b2aae0c7b..a1fb3de4db 100644 --- a/test-suite/bugs/closed/bug_4412.v +++ b/test-suite/bugs/closed/bug_4412.v @@ -2,3 +2,4 @@ Require Import Coq.Bool.Bool Coq.Setoids.Setoid. Goal forall (P : forall b : bool, b = true -> Type) (x y : bool) (H : andb x y = true) (H' : P _ H), True. intros. Fail rewrite Bool.andb_true_iff in H. +Abort. diff --git a/test-suite/bugs/closed/bug_4416.v b/test-suite/bugs/closed/bug_4416.v index 62b90b4286..600a8aa311 100644 --- a/test-suite/bugs/closed/bug_4416.v +++ b/test-suite/bugs/closed/bug_4416.v @@ -2,3 +2,4 @@ Goal exists x, x. Unset Solve Unification Constraints. unshelve refine (ex_intro _ _ _); match goal with _ => refine (_ _) end. (* Error: Incorrect number of goals (expected 2 tactics). *) +Abort. diff --git a/test-suite/bugs/closed/bug_4453.v b/test-suite/bugs/closed/bug_4453.v index 009dd5e3ca..9248b2ab8c 100644 --- a/test-suite/bugs/closed/bug_4453.v +++ b/test-suite/bugs/closed/bug_4453.v @@ -6,3 +6,5 @@ Goal Type -> True. rename A into B. intros A. Fail apply foo. +Abort. +End Foo. diff --git a/test-suite/bugs/closed/bug_4456.v b/test-suite/bugs/closed/bug_4456.v index 56a7b4f6e9..7685552725 100644 --- a/test-suite/bugs/closed/bug_4456.v +++ b/test-suite/bugs/closed/bug_4456.v @@ -462,6 +462,9 @@ Section cfg. End cfg. End Valid. +End ContextFreeGrammar. +End Parsers. +End Fiat. Section app. Context {Char : Type} {HSL : StringLike Char} (G : grammar Char) @@ -645,3 +648,4 @@ Defined. abstract t_parse_production_for. abstract t_parse_production_for. Defined. +End recursive_descent_parser. diff --git a/test-suite/bugs/closed/bug_4462.v b/test-suite/bugs/closed/bug_4462.v index c680518c6a..be6d2bea76 100644 --- a/test-suite/bugs/closed/bug_4462.v +++ b/test-suite/bugs/closed/bug_4462.v @@ -5,3 +5,4 @@ Require Setoid. Goal P -> Q. unshelve (rewrite pqrw). +Abort. diff --git a/test-suite/bugs/closed/bug_4464.v b/test-suite/bugs/closed/bug_4464.v index f8e9405d93..a0c266c0ee 100644 --- a/test-suite/bugs/closed/bug_4464.v +++ b/test-suite/bugs/closed/bug_4464.v @@ -2,3 +2,4 @@ Goal True -> True. Proof. intro H'. let H := H' in destruct H; try destruct H. +Abort. diff --git a/test-suite/bugs/closed/bug_4471.v b/test-suite/bugs/closed/bug_4471.v index 36efc42d47..dec181e430 100644 --- a/test-suite/bugs/closed/bug_4471.v +++ b/test-suite/bugs/closed/bug_4471.v @@ -4,3 +4,4 @@ Goal forall (A B : Type) (P : forall _ : prod A B, Type) (a : A) (b : B) (p p0 : Proof. intros. Fail generalize dependent (a, b). +Abort. diff --git a/test-suite/bugs/closed/bug_4479.v b/test-suite/bugs/closed/bug_4479.v index 921579d1e1..442555b319 100644 --- a/test-suite/bugs/closed/bug_4479.v +++ b/test-suite/bugs/closed/bug_4479.v @@ -1,3 +1,4 @@ Goal True. Fail autorewrite with foo. try autorewrite with foo. +Abort. diff --git a/test-suite/bugs/closed/bug_4480.v b/test-suite/bugs/closed/bug_4480.v index ec6ec7e5c2..da15e8cf33 100644 --- a/test-suite/bugs/closed/bug_4480.v +++ b/test-suite/bugs/closed/bug_4480.v @@ -9,3 +9,4 @@ Admitted. Goal True. Fail setoid_rewrite foo. Fail setoid_rewrite trueI. +Abort. diff --git a/test-suite/bugs/closed/bug_4484.v b/test-suite/bugs/closed/bug_4484.v index 6231e2d3df..adf7c82401 100644 --- a/test-suite/bugs/closed/bug_4484.v +++ b/test-suite/bugs/closed/bug_4484.v @@ -8,3 +8,4 @@ Check (match foo as k return foo = k -> True with | true => _ | false => _ end eq_refl). +Abort. diff --git a/test-suite/bugs/closed/bug_4511.v b/test-suite/bugs/closed/bug_4511.v index 0027596e59..11ee4ccd6f 100644 --- a/test-suite/bugs/closed/bug_4511.v +++ b/test-suite/bugs/closed/bug_4511.v @@ -1,2 +1,3 @@ Goal True. Fail evar I. +Abort. diff --git a/test-suite/bugs/closed/bug_4527.v b/test-suite/bugs/closed/bug_4527.v index 8749680e8d..4f8a8dd272 100644 --- a/test-suite/bugs/closed/bug_4527.v +++ b/test-suite/bugs/closed/bug_4527.v @@ -268,3 +268,5 @@ S) : In@{Ou Oa i} O (x=y). rewrite O_indpaths_beta; reflexivity. Qed. Check inO_paths@{Type}. +End Reflective_Subuniverse. +End ReflectiveSubuniverses_Theory. diff --git a/test-suite/bugs/closed/bug_4529.v b/test-suite/bugs/closed/bug_4529.v index b16d81bd7c..8e04bdca86 100644 --- a/test-suite/bugs/closed/bug_4529.v +++ b/test-suite/bugs/closed/bug_4529.v @@ -42,3 +42,4 @@ End cofe_mixin. * intros x. apply equiv_dist. + Abort. diff --git a/test-suite/bugs/closed/bug_4533.v b/test-suite/bugs/closed/bug_4533.v index f9cccd5a56..d2f9fb9099 100644 --- a/test-suite/bugs/closed/bug_4533.v +++ b/test-suite/bugs/closed/bug_4533.v @@ -228,3 +228,5 @@ v = _) r, | [ |- ?G ] => fail 1 "bad" G end. Fail rewrite concat_p_pp. + Abort. +End Lex_Reflective_Subuniverses. diff --git a/test-suite/bugs/closed/bug_4574.v b/test-suite/bugs/closed/bug_4574.v index f166eb84a9..cd6458c174 100644 --- a/test-suite/bugs/closed/bug_4574.v +++ b/test-suite/bugs/closed/bug_4574.v @@ -5,3 +5,4 @@ Definition block A (a : A) := a. Goal forall A (a : A), block Type nat. Proof. Fail reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_4580.v b/test-suite/bugs/closed/bug_4580.v index 4ffd5f0f4b..a8a446cc9b 100644 --- a/test-suite/bugs/closed/bug_4580.v +++ b/test-suite/bugs/closed/bug_4580.v @@ -4,3 +4,4 @@ Class Foo (A : Type) := foo : A. Unset Refine Instance Mode. Program Instance f1 : Foo nat := S _. +Next Obligation. exact 0. Defined. diff --git a/test-suite/bugs/closed/bug_4596.v b/test-suite/bugs/closed/bug_4596.v index 592fdb6580..bdd5edbdfb 100644 --- a/test-suite/bugs/closed/bug_4596.v +++ b/test-suite/bugs/closed/bug_4596.v @@ -12,3 +12,4 @@ Goal forall (S : Type) (b b0 : S -> nat -> bool) (str : S) (p : nat) Proof. intros ???????? H0. rewrite H0. +Abort. diff --git a/test-suite/bugs/closed/bug_4644.v b/test-suite/bugs/closed/bug_4644.v index f09b27c2b1..d8f284834c 100644 --- a/test-suite/bugs/closed/bug_4644.v +++ b/test-suite/bugs/closed/bug_4644.v @@ -50,3 +50,4 @@ Goal forall (T T' : Set) (a3 : list T), exists y2, forall (a4 : T' -> bool), (etransitivity; [ t | reflexivity ]) || fail 0 "too early". Undo. t. +Abort. diff --git a/test-suite/bugs/closed/bug_4661.v b/test-suite/bugs/closed/bug_4661.v index 03d2350a69..ffcfbdd7ea 100644 --- a/test-suite/bugs/closed/bug_4661.v +++ b/test-suite/bugs/closed/bug_4661.v @@ -8,3 +8,4 @@ End Func. Module Shortest_path (T : Test). Print Func. +End Shortest_path. diff --git a/test-suite/bugs/closed/bug_4673.v b/test-suite/bugs/closed/bug_4673.v index 0d49c6d9be..f5ee4e3b57 100644 --- a/test-suite/bugs/closed/bug_4673.v +++ b/test-suite/bugs/closed/bug_4673.v @@ -55,3 +55,4 @@ Goal forall (Char : Type) (P : forall _ : list bool, Prop) (l : list bool) (l setoid_rewrite H || fail 0 "too early". Undo. setoid_rewrite H. +Abort. diff --git a/test-suite/bugs/closed/bug_4725.v b/test-suite/bugs/closed/bug_4725.v index fd5e0fb60d..3c014ea17c 100644 --- a/test-suite/bugs/closed/bug_4725.v +++ b/test-suite/bugs/closed/bug_4725.v @@ -30,9 +30,10 @@ Proof. intros. apply remove_le. Qed. (* Program version *) -Program Fixpoint nubV `{eqDecV : @EqDec V eqV equivV} (l : list V) +Program Fixpoint nubV' `{eqDecV : @EqDec V eqV equivV} (l : list V) { measure (@length V l) lt } := match l with | nil => nil - | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs) _ + | x::xs => x :: @nubV' V eqV equivV eqDecV (removeV x xs) _ end. +Next Obligation. apply remove_le. Defined. diff --git a/test-suite/bugs/closed/bug_4811.v b/test-suite/bugs/closed/bug_4811.v index fe6e65a0f0..b90257cb3f 100644 --- a/test-suite/bugs/closed/bug_4811.v +++ b/test-suite/bugs/closed/bug_4811.v @@ -1683,3 +1683,4 @@ Goal forall x9 x8 x7 x6 x5 x4 x3 x2 x1 x0 y9 y8 y7 y6 y5 y4 y3 y2 y1 y0 : Z, (timeout 1 (apply f_equal; reflexivity)) || fail 0 "too early". Undo. Time Timeout 1 f_equal. (* Finished transaction in 0. secs (0.3u,0.s) in 8.4 *) +Abort. diff --git a/test-suite/bugs/closed/bug_4813.v b/test-suite/bugs/closed/bug_4813.v index 5f8ea74c1a..d1a2ebe820 100644 --- a/test-suite/bugs/closed/bug_4813.v +++ b/test-suite/bugs/closed/bug_4813.v @@ -7,3 +7,4 @@ Definition reflexivityValid (_ : unit) := True. Definition reflexivityProver_correct : ProverT_correct {| Facts := unit |}. Proof. eapply Build_ProverT_correct with (Valid := reflexivityValid). +Abort. diff --git a/test-suite/bugs/closed/bug_4818.v b/test-suite/bugs/closed/bug_4818.v index 7dc6e65725..186c4425c1 100644 --- a/test-suite/bugs/closed/bug_4818.v +++ b/test-suite/bugs/closed/bug_4818.v @@ -22,3 +22,4 @@ Admitted. (* Anomaly: Universe Product.5189 undefined. Please report. *) +End Product. diff --git a/test-suite/bugs/closed/bug_4893.v b/test-suite/bugs/closed/bug_4893.v index 9a35bcf954..1b1ca7c108 100644 --- a/test-suite/bugs/closed/bug_4893.v +++ b/test-suite/bugs/closed/bug_4893.v @@ -2,3 +2,4 @@ Goal True. evar (P: Prop). assert (H : P); [|subst P]; [exact I|]. let T := type of H in not_evar T. +Abort. diff --git a/test-suite/bugs/closed/bug_4969.v b/test-suite/bugs/closed/bug_4969.v index 4dee41e221..d6d3021200 100644 --- a/test-suite/bugs/closed/bug_4969.v +++ b/test-suite/bugs/closed/bug_4969.v @@ -9,3 +9,4 @@ Proof. auto. Qed. Goal True. class_apply @silly; [reflexivity|]. reflexivity. Fail Qed. +Abort. diff --git a/test-suite/bugs/closed/bug_5045.v b/test-suite/bugs/closed/bug_5045.v index dc38738d8f..bda2adc760 100644 --- a/test-suite/bugs/closed/bug_5045.v +++ b/test-suite/bugs/closed/bug_5045.v @@ -1,3 +1,4 @@ Axiom silly : 1 = 1 -> nat -> nat. Goal forall pf : 1 = 1, silly pf 0 = 0 -> True. Fail generalize (@eq nat). +Abort. diff --git a/test-suite/bugs/closed/bug_5078.v b/test-suite/bugs/closed/bug_5078.v index ca73cbcc18..f07085d900 100644 --- a/test-suite/bugs/closed/bug_5078.v +++ b/test-suite/bugs/closed/bug_5078.v @@ -3,3 +3,4 @@ Tactic Notation "unfold_hyp" hyp(H) := cbv delta [H]. Goal True -> Type. intro H''. Fail unfold_hyp H''. +Abort. diff --git a/test-suite/bugs/closed/bug_5093.v b/test-suite/bugs/closed/bug_5093.v index 3ded4dd304..4b6d774405 100644 --- a/test-suite/bugs/closed/bug_5093.v +++ b/test-suite/bugs/closed/bug_5093.v @@ -9,3 +9,4 @@ Goal P 100. Proof. Fail typeclasses eauto 100 with foobar. typeclasses eauto 101 with foobar. +Abort. diff --git a/test-suite/bugs/closed/bug_5095.v b/test-suite/bugs/closed/bug_5095.v index b6f38e3e84..b8d97f0eb2 100644 --- a/test-suite/bugs/closed/bug_5095.v +++ b/test-suite/bugs/closed/bug_5095.v @@ -3,3 +3,4 @@ Goal let x := Set in let y := x in True. intros x y. (* There used to have a too strict dependency test there *) set (s := Set) in (value of x). +Abort. diff --git a/test-suite/bugs/closed/bug_5153.v b/test-suite/bugs/closed/bug_5153.v index be6407b5fa..80d308f782 100644 --- a/test-suite/bugs/closed/bug_5153.v +++ b/test-suite/bugs/closed/bug_5153.v @@ -6,3 +6,4 @@ Goal forall (H : forall t : some_type, @Ty t -> False) (H' : False -> 1 = 2), 1 Proof. intros H H'. specialize (H' (@H _ O)). (* was failing *) +Abort. diff --git a/test-suite/bugs/closed/bug_5180.v b/test-suite/bugs/closed/bug_5180.v index 05603a048c..c26ce52da2 100644 --- a/test-suite/bugs/closed/bug_5180.v +++ b/test-suite/bugs/closed/bug_5180.v @@ -62,3 +62,4 @@ The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type *) all:compute in *. all:exact x. +Abort. diff --git a/test-suite/bugs/closed/bug_5193.v b/test-suite/bugs/closed/bug_5193.v index cc8739afe6..0a52dcdef1 100644 --- a/test-suite/bugs/closed/bug_5193.v +++ b/test-suite/bugs/closed/bug_5193.v @@ -12,3 +12,4 @@ Context `{Finx_eqdec : forall n, Eqdec (Finx n)}. Goal {x : Type & Eqdec x}. eexists. try typeclasses eauto 1 with typeclass_instances. +Abort. diff --git a/test-suite/bugs/closed/bug_5203.v b/test-suite/bugs/closed/bug_5203.v index b0161cc530..2c4d1a9fb7 100644 --- a/test-suite/bugs/closed/bug_5203.v +++ b/test-suite/bugs/closed/bug_5203.v @@ -2,3 +2,4 @@ Goal True. Typeclasses eauto := debug. Fail solve [ typeclasses eauto ]. Fail typeclasses eauto. +Abort. diff --git a/test-suite/bugs/closed/bug_5219.v b/test-suite/bugs/closed/bug_5219.v index f7cec1a0cf..6798c1ae4d 100644 --- a/test-suite/bugs/closed/bug_5219.v +++ b/test-suite/bugs/closed/bug_5219.v @@ -8,3 +8,4 @@ Goal forall x : sigT (fun x => x = 1), True. lazymatch goal with | [ H : _ = _ |- _ ] => idtac end. +Abort. diff --git a/test-suite/bugs/closed/bug_5321.v b/test-suite/bugs/closed/bug_5321.v index 3c32a4cb4d..37866fcc94 100644 --- a/test-suite/bugs/closed/bug_5321.v +++ b/test-suite/bugs/closed/bug_5321.v @@ -16,3 +16,4 @@ Proof. intros. etransitivity; [ | exact (proj2_sig_path H) ]. Fail clearbody fpf. +Abort. diff --git a/test-suite/bugs/closed/bug_5322.v b/test-suite/bugs/closed/bug_5322.v index 01aec8f29b..7664d312e9 100644 --- a/test-suite/bugs/closed/bug_5322.v +++ b/test-suite/bugs/closed/bug_5322.v @@ -12,3 +12,4 @@ Definition bound_op {var} refine match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with | _ => _ end. +Abort. diff --git a/test-suite/bugs/closed/bug_5359.v b/test-suite/bugs/closed/bug_5359.v index a5a96db2c3..1f202e4396 100644 --- a/test-suite/bugs/closed/bug_5359.v +++ b/test-suite/bugs/closed/bug_5359.v @@ -216,3 +216,4 @@ Goal False. (Ring_polynom.PEX Z 3)))) :: nil)%list ) in Nsatz.nsatz_compute (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). +Abort. diff --git a/test-suite/bugs/closed/bug_5372.v b/test-suite/bugs/closed/bug_5372.v index e60244cd1d..e36b7a5d70 100644 --- a/test-suite/bugs/closed/bug_5372.v +++ b/test-suite/bugs/closed/bug_5372.v @@ -6,3 +6,4 @@ Function odd (n:nat) := | S n => true end with even (n:nat) := false. +Reset odd. diff --git a/test-suite/bugs/closed/bug_5414.v b/test-suite/bugs/closed/bug_5414.v index 2522a274fb..bf4e7133b7 100644 --- a/test-suite/bugs/closed/bug_5414.v +++ b/test-suite/bugs/closed/bug_5414.v @@ -10,3 +10,4 @@ Goal foo. intros k. elim k. (* elim because elim keeps names *) intros. Check a. (* We check that the name is "a" *) +Abort. diff --git a/test-suite/bugs/closed/bug_5434.v b/test-suite/bugs/closed/bug_5434.v index 5d2460face..b15e947531 100644 --- a/test-suite/bugs/closed/bug_5434.v +++ b/test-suite/bugs/closed/bug_5434.v @@ -16,3 +16,4 @@ Goal True. | sig (fun a : ?A => ?P) -> _ => pose (fun a : A => a = a /\ P = P) end. +Abort. diff --git a/test-suite/bugs/closed/bug_5449.v b/test-suite/bugs/closed/bug_5449.v index d7fc2aaa00..47ecba956e 100644 --- a/test-suite/bugs/closed/bug_5449.v +++ b/test-suite/bugs/closed/bug_5449.v @@ -4,3 +4,4 @@ Require Import Coq.PArith.BinPos. Goal forall x y, {Pos.compare_cont Gt x y = Gt} + {Pos.compare_cont Gt x y <> Gt}. intros. decide equality. +Abort. diff --git a/test-suite/bugs/closed/bug_5476.v b/test-suite/bugs/closed/bug_5476.v index 7c0c2c1dfd..4bfa011762 100644 --- a/test-suite/bugs/closed/bug_5476.v +++ b/test-suite/bugs/closed/bug_5476.v @@ -26,3 +26,4 @@ Proof. end | fail 1 "could not find" X ] end. +Abort. diff --git a/test-suite/bugs/closed/bug_5486.v b/test-suite/bugs/closed/bug_5486.v index b1ddfe24bf..b086fbfa6e 100644 --- a/test-suite/bugs/closed/bug_5486.v +++ b/test-suite/bugs/closed/bug_5486.v @@ -13,3 +13,4 @@ Goal forall (T : Type) (p : prod (prod T T) bool) (Fm : Set) (f : Fm) (k : | [ |- ?f (let (a, b) := ?d in @?e a b) = ?rhs ] => pose (let (a, b) := d in e a b) as t0 end. +Abort. diff --git a/test-suite/bugs/closed/bug_5487.v b/test-suite/bugs/closed/bug_5487.v index 9b995f4503..36999f76df 100644 --- a/test-suite/bugs/closed/bug_5487.v +++ b/test-suite/bugs/closed/bug_5487.v @@ -7,3 +7,4 @@ Proof. | [ |- ?x = ?y ] => match x with y => idtac end end. +Abort. diff --git a/test-suite/bugs/closed/bug_5501.v b/test-suite/bugs/closed/bug_5501.v index 24739a3658..e5e8a89278 100644 --- a/test-suite/bugs/closed/bug_5501.v +++ b/test-suite/bugs/closed/bug_5501.v @@ -19,3 +19,4 @@ Global Instance Pred_All_instance (A : Pred_All) : All A := P'_All A. Definition Pred_All_proof {A : Pred_All} (a : A) : P A a. Proof. solve[auto using proof]. +Abort. diff --git a/test-suite/bugs/closed/bug_5547.v b/test-suite/bugs/closed/bug_5547.v index 79633f4893..ee4a9b083a 100644 --- a/test-suite/bugs/closed/bug_5547.v +++ b/test-suite/bugs/closed/bug_5547.v @@ -14,3 +14,4 @@ Fail refine (fun x | (y,J) => true end ). +Abort. diff --git a/test-suite/bugs/closed/bug_5578.v b/test-suite/bugs/closed/bug_5578.v index 19d36e635d..a8a4dd6e30 100644 --- a/test-suite/bugs/closed/bug_5578.v +++ b/test-suite/bugs/closed/bug_5578.v @@ -55,3 +55,4 @@ Goal forall (Rat : Set) (PositiveMap_t : Set -> Set) (Bind (k eta) (fun rands => ret_bool (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands)))))). (* Error: Anomaly "Signature and its instance do not match." Please report at http://coq.inria.fr/bugs/. *) +Abort. diff --git a/test-suite/bugs/closed/bug_5666.v b/test-suite/bugs/closed/bug_5666.v index d55a6e57b4..1fe7fa19eb 100644 --- a/test-suite/bugs/closed/bug_5666.v +++ b/test-suite/bugs/closed/bug_5666.v @@ -2,3 +2,4 @@ Inductive foo := Foo : False -> foo. Goal foo. try (constructor ; fail 0). Fail try (constructor ; fail 1). +Abort. diff --git a/test-suite/bugs/closed/bug_5671.v b/test-suite/bugs/closed/bug_5671.v index c9a085045a..dfa7ed5d69 100644 --- a/test-suite/bugs/closed/bug_5671.v +++ b/test-suite/bugs/closed/bug_5671.v @@ -5,3 +5,4 @@ Axiom a : forall x, x=0 -> True. Lemma lem (x y1 y2:nat) (H:x=0) (H0:eq y1 y2) : y1 = y2. specialize a with (1:=H). clear H x. intros _. setoid_rewrite H0. +Abort. diff --git a/test-suite/bugs/closed/bug_5707.v b/test-suite/bugs/closed/bug_5707.v index 785844c66d..096069049a 100644 --- a/test-suite/bugs/closed/bug_5707.v +++ b/test-suite/bugs/closed/bug_5707.v @@ -10,3 +10,4 @@ Inductive foo := Foo { proj1 : nat; proj2 : nat }. Goal forall x : foo, True. Proof. intros x. destruct x. +Abort. diff --git a/test-suite/bugs/closed/bug_5741.v b/test-suite/bugs/closed/bug_5741.v index f6598f192d..27bf9e76ef 100644 --- a/test-suite/bugs/closed/bug_5741.v +++ b/test-suite/bugs/closed/bug_5741.v @@ -2,3 +2,4 @@ Goal True. info_trivial. +Abort. diff --git a/test-suite/bugs/closed/bug_5749.v b/test-suite/bugs/closed/bug_5749.v index 81bfe351c5..7a2944dc7e 100644 --- a/test-suite/bugs/closed/bug_5749.v +++ b/test-suite/bugs/closed/bug_5749.v @@ -16,3 +16,6 @@ a))). SetUnfold (Q) (fold_right _ _ (fun (s : lType2) => let (P, _) := s in and (P m)) (Q) (fhl1)). + Abort. + +End Filter_Help. diff --git a/test-suite/bugs/closed/bug_5750.v b/test-suite/bugs/closed/bug_5750.v index 6d0e21f5d0..d5527d9303 100644 --- a/test-suite/bugs/closed/bug_5750.v +++ b/test-suite/bugs/closed/bug_5750.v @@ -1,3 +1,4 @@ (* Check printability of the hole of the context *) Goal 0 = 0. match goal with |- context c [0] => idtac c end. +Abort. diff --git a/test-suite/bugs/closed/bug_5757.v b/test-suite/bugs/closed/bug_5757.v index 0d0f2eed44..4d90c44cfe 100644 --- a/test-suite/bugs/closed/bug_5757.v +++ b/test-suite/bugs/closed/bug_5757.v @@ -74,3 +74,4 @@ match goal with change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v) end. Abort. +End Tests. diff --git a/test-suite/bugs/closed/bug_6534.v b/test-suite/bugs/closed/bug_6534.v index f5013994c5..8e3c2bb1a1 100644 --- a/test-suite/bugs/closed/bug_6534.v +++ b/test-suite/bugs/closed/bug_6534.v @@ -5,3 +5,4 @@ refine ((fun x x => _ tt) tt tt). let t := match goal with [ |- ?P ] => P end in let _ := type of t in idtac. +Abort. diff --git a/test-suite/bugs/closed/bug_6631.v b/test-suite/bugs/closed/bug_6631.v index 100dc13fc8..0833ae17ff 100644 --- a/test-suite/bugs/closed/bug_6631.v +++ b/test-suite/bugs/closed/bug_6631.v @@ -5,3 +5,4 @@ Proof. transitivity 2; [refine (eq_refl 2)|]. transitivity 2. 2:abstract exact (eq_refl 2). +Abort. diff --git a/test-suite/bugs/closed/bug_7392.v b/test-suite/bugs/closed/bug_7392.v index cf465c6588..df4408d899 100644 --- a/test-suite/bugs/closed/bug_7392.v +++ b/test-suite/bugs/closed/bug_7392.v @@ -7,3 +7,4 @@ eapply H0. clear H1. apply ER. simpl. +Abort. diff --git a/test-suite/bugs/opened/HoTT_coq_106.v b/test-suite/bugs/opened/HoTT_coq_106.v index a566459546..5873ba6c5d 100644 --- a/test-suite/bugs/opened/HoTT_coq_106.v +++ b/test-suite/bugs/opened/HoTT_coq_106.v @@ -50,3 +50,4 @@ UNDEFINED UNIVERSES: Top.32 Top.33CONSTRAINTS:[] [A H B] |- ?13 == ?12 [] [A H B H0] |- ?12 == ?15 *) +Abort. diff --git a/test-suite/bugs/opened/bug_3277.v b/test-suite/bugs/opened/bug_3277.v index 5f4231363a..54629d8511 100644 --- a/test-suite/bugs/opened/bug_3277.v +++ b/test-suite/bugs/opened/bug_3277.v @@ -5,3 +5,4 @@ Goal True. Admitted. Goal True. Fail exact ltac:(evarr _). (* Error: Cannot infer this placeholder. *) +Abort. diff --git a/test-suite/bugs/opened/bug_3311.v b/test-suite/bugs/opened/bug_3311.v index 1c66bc1e55..23752acf1c 100644 --- a/test-suite/bugs/opened/bug_3311.v +++ b/test-suite/bugs/opened/bug_3311.v @@ -8,3 +8,4 @@ Tactic failure:setoid rewrite failed: Unable to satisfy the rewriting constraint Could not find an instance for "subrelation eq (Basics.flip Basics.impl)". With the following constraints: ?3 : "True" *) +Abort. diff --git a/test-suite/bugs/opened/bug_3312.v b/test-suite/bugs/opened/bug_3312.v index 749921e2f6..bf87c3995f 100644 --- a/test-suite/bugs/opened/bug_3312.v +++ b/test-suite/bugs/opened/bug_3312.v @@ -3,3 +3,4 @@ Axiom bar : 0 = 1. Goal 0 = 1. Fail rewrite_strat bar. (* Toplevel input, characters 15-32: Error: Tactic failure:setoid rewrite failed: Nothing to rewrite. *) +Abort. diff --git a/test-suite/bugs/opened/bug_3343.v b/test-suite/bugs/opened/bug_3343.v index 6c5a85f9cf..7c0470bf96 100644 --- a/test-suite/bugs/opened/bug_3343.v +++ b/test-suite/bugs/opened/bug_3343.v @@ -44,3 +44,4 @@ Proof. induction m. Fail progress simpl. (* simpl did nothing here, while it does something inside the section; this is probably a bug*) +Abort. diff --git a/test-suite/bugs/opened/bug_3345.v b/test-suite/bugs/opened/bug_3345.v index 3e3da6df71..bc0f1a8604 100644 --- a/test-suite/bugs/opened/bug_3345.v +++ b/test-suite/bugs/opened/bug_3345.v @@ -143,3 +143,4 @@ cannot be applied to the terms "e0" : "nth_error Bound (ibound idx') = e" The 2nd term has type "nth_error Bound (ibound idx') = e" which should be coercible to "e = e". *) +Abort. diff --git a/test-suite/bugs/opened/bug_3370.v b/test-suite/bugs/opened/bug_3370.v index 4964bf96c0..d6fc88a03a 100644 --- a/test-suite/bugs/opened/bug_3370.v +++ b/test-suite/bugs/opened/bug_3370.v @@ -10,3 +10,4 @@ Local Open Scope string_scope. Goal "asdf" = "bds". Fail set_strings. (* Error: Ltac variable s is bound to "asdf" which cannot be coerced to a fresh identifier. *) +Abort. diff --git a/test-suite/bugs/opened/bug_3395.v b/test-suite/bugs/opened/bug_3395.v index 5ca48fc9d6..70b3a48a06 100644 --- a/test-suite/bugs/opened/bug_3395.v +++ b/test-suite/bugs/opened/bug_3395.v @@ -229,3 +229,4 @@ Proof. unfold yoneda; simpl in *. Fail Timeout 1 exact CYE. Time exact CYE. (* Finished transaction in 0. secs (0.012001u,0.s) *) +Abort. diff --git a/test-suite/bugs/opened/bug_3463.v b/test-suite/bugs/opened/bug_3463.v index 124f2bcc03..3de9e2ee5f 100644 --- a/test-suite/bugs/opened/bug_3463.v +++ b/test-suite/bugs/opened/bug_3463.v @@ -10,3 +10,4 @@ Goal True. test2 nat (1 + _). test3 (1 + _) nat. test3 (1 + _ : nat) nat. +Abort. diff --git a/test-suite/bugs/opened/bug_3655.v b/test-suite/bugs/opened/bug_3655.v index 841f77febb..a9735be932 100644 --- a/test-suite/bugs/opened/bug_3655.v +++ b/test-suite/bugs/opened/bug_3655.v @@ -7,3 +7,4 @@ Goal True. guess it is still a bug in the sense that the semantics of pose is not preserved *) foo baz'. +Abort. diff --git a/test-suite/bugs/opened/bug_4755.v b/test-suite/bugs/opened/bug_4755.v index 9cc0d361ea..50e40c5fad 100644 --- a/test-suite/bugs/opened/bug_4755.v +++ b/test-suite/bugs/opened/bug_4755.v @@ -32,3 +32,4 @@ Proof. intro. pose proof (_ : (Proper (_ ==> eq ==> _) and)). Fail setoid_rewrite (FG _ _); []. (* In 8.5: Error: Tactic failure: Incorrect number of goals (expected 2 tactics); works in 8.4 *) +Abort. diff --git a/test-suite/bugs/opened/bug_4778.v b/test-suite/bugs/opened/bug_4778.v index 633d158e96..d66373ed7c 100644 --- a/test-suite/bugs/opened/bug_4778.v +++ b/test-suite/bugs/opened/bug_4778.v @@ -33,3 +33,4 @@ Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. intro. pose proof (_ : (Proper (_ ==> eq ==> _) and)). Fail setoid_rewrite (FG _ _); [ | reflexivity.. ]. (* this should succeed without [Fail], as it does in 8.4 *) +Abort. diff --git a/test-suite/failure/ClearBody.v b/test-suite/failure/ClearBody.v index e321e59f58..e865f121e8 100644 --- a/test-suite/failure/ClearBody.v +++ b/test-suite/failure/ClearBody.v @@ -6,3 +6,4 @@ set (n := 0) in *. set (I := refl_equal 0) in *. change (n = 0) in (type of I). Fail clearbody n. +Abort. diff --git a/test-suite/failure/Reordering.v b/test-suite/failure/Reordering.v index e79b20737b..75cf372b43 100644 --- a/test-suite/failure/Reordering.v +++ b/test-suite/failure/Reordering.v @@ -3,3 +3,4 @@ Goal forall (A:Set) (x:A) (A':=A), True. intros. Fail change ((fun (_:A') => Set) x) in (type of A). +Abort. diff --git a/test-suite/failure/Sections.v b/test-suite/failure/Sections.v index 928e214f47..815fadd8a5 100644 --- a/test-suite/failure/Sections.v +++ b/test-suite/failure/Sections.v @@ -2,3 +2,5 @@ Module A. Section B. Fail End A. (*End A.*) +End B. +End A. diff --git a/test-suite/failure/Tauto.v b/test-suite/failure/Tauto.v index 81d5b6358e..c10cb0b869 100644 --- a/test-suite/failure/Tauto.v +++ b/test-suite/failure/Tauto.v @@ -20,3 +20,4 @@ Goal (forall A : Prop, A \/ ~ A) -> forall x y : nat, x = y \/ x <> y. Proof. Fail tauto. +Abort. diff --git a/test-suite/failure/autorewritein.v b/test-suite/failure/autorewritein.v index 191e035b3a..b734d85933 100644 --- a/test-suite/failure/autorewritein.v +++ b/test-suite/failure/autorewritein.v @@ -10,6 +10,4 @@ Lemma ResAck2 : forall H:(Ack 2 2 = 7 -> False), H=H -> False. Proof. intros. Fail autorewrite with base0 in * using try (apply H1;reflexivity). - - - +Abort. diff --git a/test-suite/failure/clashes.v b/test-suite/failure/clashes.v index 1a59ec66d1..1abec329c4 100644 --- a/test-suite/failure/clashes.v +++ b/test-suite/failure/clashes.v @@ -7,3 +7,4 @@ Section S. Variable n : nat. Fail Inductive P : Set := n : P. +End S. diff --git a/test-suite/failure/coqbugs0266.v b/test-suite/failure/coqbugs0266.v index cc3f307a20..79ea5ede47 100644 --- a/test-suite/failure/coqbugs0266.v +++ b/test-suite/failure/coqbugs0266.v @@ -5,3 +5,5 @@ Let a := 0. Definition b := a. Goal b = b. Fail clear a. +Abort. +End S. diff --git a/test-suite/failure/evarclear1.v b/test-suite/failure/evarclear1.v index 60adadef40..82697bf41e 100644 --- a/test-suite/failure/evarclear1.v +++ b/test-suite/failure/evarclear1.v @@ -7,4 +7,4 @@ unfold z. clear y z. (* should fail because the evar should no longer be allowed to depend on z *) Fail instantiate (1:=z). - +Abort. diff --git a/test-suite/failure/evarclear2.v b/test-suite/failure/evarclear2.v index 0f7768112b..45eeef6aa7 100644 --- a/test-suite/failure/evarclear2.v +++ b/test-suite/failure/evarclear2.v @@ -7,3 +7,4 @@ rename y into z. unfold z at 1 2. (* should fail because the evar type depends on z *) Fail clear z. +Abort. diff --git a/test-suite/failure/fixpoint2.v b/test-suite/failure/fixpoint2.v index 7f11a99b16..2d2d6a02cd 100644 --- a/test-suite/failure/fixpoint2.v +++ b/test-suite/failure/fixpoint2.v @@ -4,3 +4,4 @@ Goal nat->nat. fix f 1. intro n; apply f; assumption. Fail Guarded. +Abort. diff --git a/test-suite/failure/ltac1.v b/test-suite/failure/ltac1.v index eef16525d6..1cd119f3eb 100644 --- a/test-suite/failure/ltac1.v +++ b/test-suite/failure/ltac1.v @@ -5,3 +5,4 @@ Ltac X := match goal with Goal True -> True -> True. intros. Fail X. +Abort. diff --git a/test-suite/failure/ltac2.v b/test-suite/failure/ltac2.v index d66fb6808d..8a9157df84 100644 --- a/test-suite/failure/ltac2.v +++ b/test-suite/failure/ltac2.v @@ -4,3 +4,4 @@ Goal True -> True. Fail E ltac:(match goal with | |- _ => intro H end). +Abort. diff --git a/test-suite/failure/ltac4.v b/test-suite/failure/ltac4.v index 5b0396d164..58b791eb38 100644 --- a/test-suite/failure/ltac4.v +++ b/test-suite/failure/ltac4.v @@ -3,4 +3,4 @@ Goal forall n : nat, n = n. induction n. Fail try REflexivity. - +Abort. diff --git a/test-suite/failure/pattern.v b/test-suite/failure/pattern.v index 216eb254c1..480f579502 100644 --- a/test-suite/failure/pattern.v +++ b/test-suite/failure/pattern.v @@ -7,3 +7,4 @@ Variable P : forall m : nat, m = n -> Prop. Goal forall p : n = n, P n p. intro. Fail pattern n, p. +Abort. diff --git a/test-suite/failure/prop_set_proof_irrelevance.v b/test-suite/failure/prop_set_proof_irrelevance.v index fee33432b0..ed6d4300e0 100644 --- a/test-suite/failure/prop_set_proof_irrelevance.v +++ b/test-suite/failure/prop_set_proof_irrelevance.v @@ -10,3 +10,4 @@ Lemma paradox : False. Fail apply proof_irrelevance. (* inlined version is rejected *) apply proof_irrelevance_set. Qed.*) +Abort. diff --git a/test-suite/failure/rewrite_in_goal.v b/test-suite/failure/rewrite_in_goal.v index dedfdf01eb..e7823f1cb1 100644 --- a/test-suite/failure/rewrite_in_goal.v +++ b/test-suite/failure/rewrite_in_goal.v @@ -1,3 +1,4 @@ Goal forall T1 T2 (H:T1=T2) (f:T1->Prop) (x:T1) , f x -> Type. intros until x. Fail rewrite H in x. +Abort. diff --git a/test-suite/failure/rewrite_in_hyp.v b/test-suite/failure/rewrite_in_hyp.v index 1eef0fa033..f1b2203acc 100644 --- a/test-suite/failure/rewrite_in_hyp.v +++ b/test-suite/failure/rewrite_in_hyp.v @@ -1,3 +1,4 @@ Goal forall (T1 T2 : Type) (f:T1 -> Prop) (x:T1) (H:T1=T2), f x -> 0=1. intros T1 T2 f x H fx. Fail rewrite H in x. +Abort. diff --git a/test-suite/failure/rewrite_in_hyp2.v b/test-suite/failure/rewrite_in_hyp2.v index 112a856e32..60994fe1ed 100644 --- a/test-suite/failure/rewrite_in_hyp2.v +++ b/test-suite/failure/rewrite_in_hyp2.v @@ -6,3 +6,4 @@ Goal forall b, S b = O -> (fun a => 0 = (S a)) b -> True. intros b H H0. Fail rewrite H in H0. +Abort. diff --git a/test-suite/failure/subtyping.v b/test-suite/failure/subtyping.v index e48c668916..6996f4232a 100644 --- a/test-suite/failure/subtyping.v +++ b/test-suite/failure/subtyping.v @@ -19,3 +19,10 @@ Module TT : T. | L1 : (A -> Prop) -> L. Fail End TT. + + Reset L. + Inductive L : Prop := + | L0 + | L1 : (A -> Prop) -> L. + +End TT. diff --git a/test-suite/modules/SeveralWith.v b/test-suite/modules/SeveralWith.v index bbf72a7648..4426f2710a 100644 --- a/test-suite/modules/SeveralWith.v +++ b/test-suite/modules/SeveralWith.v @@ -10,3 +10,4 @@ End ES. Module Make (AX : S) (X : ES with Definition A := AX.A with Definition eq := @eq AX.A). +End Make. diff --git a/test-suite/modules/WithDefUBinders.v b/test-suite/modules/WithDefUBinders.v index e683455162..00a93b5fdf 100644 --- a/test-suite/modules/WithDefUBinders.v +++ b/test-suite/modules/WithDefUBinders.v @@ -13,3 +13,5 @@ Fail Module M' : T with Definition foo := Type. (* Without the binder expression we have to do trickery to get the universes in the right order. *) Module M' : T with Definition foo := let t := Type in t. +Definition foo := let t := Type in t. +End M'. diff --git a/test-suite/modules/errors.v b/test-suite/modules/errors.v index d1658786ea..487de5801c 100644 --- a/test-suite/modules/errors.v +++ b/test-suite/modules/errors.v @@ -1,70 +1,90 @@ +(* coq-prog-args: ("-impredicative-set") *) (* Inductive mismatches *) Module Type SA. Inductive TA : nat -> Prop := CA : nat -> TA 0. End SA. Module MA : SA. Inductive TA : Prop := CA : bool -> TA. Fail End MA. +Reset Initial. -Module Type SA. Inductive TA := CA : nat -> TA. End SA. -Module MA : SA. Inductive TA := CA : bool -> TA. Fail End MA. +Module Type SA0. Inductive TA0 := CA0 : nat -> TA0. End SA0. +Module MA0 : SA0. Inductive TA0 := CA0 : bool -> TA0. Fail End MA0. +Reset Initial. -Module Type SA. Inductive TA := CA : nat -> TA. End SA. -Module MA : SA. Inductive TA := CA : bool -> nat -> TA. Fail End MA. +Module Type SA1. Inductive TA1 := CA1 : nat -> TA1. End SA1. +Module MA1 : SA1. Inductive TA1 := CA1 : bool -> nat -> TA1. Fail End MA1. +Reset Initial. Module Type SA2. Inductive TA2 := CA2 : nat -> TA2. End SA2. Module MA2 : SA2. Inductive TA2 := CA2 : nat -> TA2 | DA2 : TA2. Fail End MA2. +Reset Initial. Module Type SA3. Inductive TA3 := CA3 : nat -> TA3. End SA3. Module MA3 : SA3. Inductive TA3 := CA3 : nat -> TA3 with UA3 := DA3. Fail End MA3. +Reset Initial. Module Type SA4. Inductive TA4 := CA4 : nat -> TA4 with UA4 := DA4. End SA4. Module MA4 : SA4. Inductive TA4 := CA4 : nat -> TA4 with VA4 := DA4. Fail End MA4. +Reset Initial. Module Type SA5. Inductive TA5 := CA5 : nat -> TA5 with UA5 := DA5. End SA5. Module MA5 : SA5. Inductive TA5 := CA5 : nat -> TA5 with UA5 := EA5. Fail End MA5. +Reset Initial. Module Type SA6. Inductive TA6 (A:Type) := CA6 : A -> TA6 A. End SA6. Module MA6 : SA6. Inductive TA6 (A B:Type):= CA6 : A -> TA6 A B. Fail End MA6. +Reset Initial. Module Type SA7. Inductive TA7 (A:Type) := CA7 : A -> TA7 A. End SA7. Module MA7 : SA7. CoInductive TA7 (A:Type):= CA7 : A -> TA7 A. Fail End MA7. +Reset Initial. Module Type SA8. CoInductive TA8 (A:Type) := CA8 : A -> TA8 A. End SA8. Module MA8 : SA8. Inductive TA8 (A:Type):= CA8 : A -> TA8 A. Fail End MA8. +Reset Initial. Module Type SA9. Record TA9 (A:Type) := { CA9 : A }. End SA9. Module MA9 : SA9. Inductive TA9 (A:Type):= CA9 : A -> TA9 A. Fail End MA9. +Reset Initial. Module Type SA10. Inductive TA10 (A:Type) := CA10 : A -> TA10 A. End SA10. Module MA10 : SA10. Record TA10 (A:Type):= { CA10 : A }. Fail End MA10. +Reset Initial. Module Type SA11. Record TA11 (A:Type):= { CA11 : A }. End SA11. Module MA11 : SA11. Record TA11 (A:Type):= { DA11 : A }. Fail End MA11. +Reset Initial. (* Basic mismatches *) Module Type SB. Inductive TB := CB : nat -> TB. End SB. Module MB : SB. Module Type TB. End TB. Fail End MB. +Inductive TB := CB : nat -> TB. End MB. Module Type SC. Module Type TC. End TC. End SC. Module MC : SC. Inductive TC := CC : nat -> TC. Fail End MC. +Reset Initial. Module Type SD. Module TD. End TD. End SD. Module MD : SD. Inductive TD := DD : nat -> TD. Fail End MD. +Reset Initial. Module Type SE. Definition DE := nat. End SE. Module ME : SE. Definition DE := bool. Fail End ME. +Reset Initial. Module Type SF. Parameter DF : nat. End SF. Module MF : SF. Definition DF := bool. Fail End MF. +Reset Initial. (* Needs a type constraint in module type *) Module Type SG. Definition DG := Type. End SG. Module MG : SG. Definition DG := Type : Type. Fail End MG. +Reset Initial. (* Should work *) -Module Type SA7. Inductive TA7 (A:Type) := CA7 : A -> TA7 A. End SA7. -Module MA7 : SA7. Inductive TA7 (B:Type):= CA7 : B -> TA7 B. End MA7. +Module Type SA70. Inductive TA70 (A:Type) := CA70 : A -> TA70 A. End SA70. +Module MA70 : SA70. Inductive TA70 (B:Type):= CA70 : B -> TA70 B. End MA70. -Module Type SA11. Record TA11 (B:Type):= { CA11 : B }. End SA11. -Module MA11 : SA11. Record TA11 (A:Type):= { CA11 : A }. End MA11. +Module Type SA12. Record TA12 (B:Type):= { CA12 : B }. End SA12. +Module MA12 : SA12. Record TA12 (A:Type):= { CA12 : A }. End MA12. -Module Type SE. Parameter DE : Type. End SE. -Module ME : SE. Definition DE := Type : Type. End ME. +Module Type SH. Parameter DH : Type. End SH. +Module MH : SH. Definition DH := Type : Type. End MH. diff --git a/test-suite/modules/fun_objects.v b/test-suite/modules/fun_objects.v index dce2ffd50b..fe1372298e 100644 --- a/test-suite/modules/fun_objects.v +++ b/test-suite/modules/fun_objects.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-impredicative-set") *) Set Implicit Arguments. Unset Strict Implicit. diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v index e4fa7044e7..43718a0f07 100644 --- a/test-suite/output/Cases.v +++ b/test-suite/output/Cases.v @@ -187,6 +187,7 @@ let p := fresh "p" in |- eq_refl ?p = _ => pose (match eq_refl p in _ = z return p=p /\ z=z with eq_refl => conj eq_refl eq_refl end) end. Show. +Abort. Set Printing Allow Match Default Clause. diff --git a/test-suite/output/Errors.v b/test-suite/output/Errors.v index c9b5091347..7375227827 100644 --- a/test-suite/output/Errors.v +++ b/test-suite/output/Errors.v @@ -31,3 +31,6 @@ Abort. Fail Goal forall a f, f a = 0. Fail Goal forall f x, id f x = 0. Fail Goal forall f P, P (f 0). + +Definition t := unit. +End M. diff --git a/test-suite/output/Existentials.v b/test-suite/output/Existentials.v index 7388468399..924f1f5592 100644 --- a/test-suite/output/Existentials.v +++ b/test-suite/output/Existentials.v @@ -12,3 +12,5 @@ clearbody q. clear p. (* Error ... *) Show Existentials. +Abort. +End Test. diff --git a/test-suite/output/Match_subterm.v b/test-suite/output/Match_subterm.v index 2c44b1879f..bf862c946d 100644 --- a/test-suite/output/Match_subterm.v +++ b/test-suite/output/Match_subterm.v @@ -4,3 +4,4 @@ match goal with idtac v ; fail | _ => idtac 2 end. +Abort. diff --git a/test-suite/output/Naming.v b/test-suite/output/Naming.v index 327643dc57..7f3b332d7d 100644 --- a/test-suite/output/Naming.v +++ b/test-suite/output/Naming.v @@ -89,3 +89,4 @@ Show. apply H with (a:=a). (* test compliance with printing *) Abort. +End A. diff --git a/test-suite/output/ShowMatch.v b/test-suite/output/ShowMatch.v index 02b7eada83..9cf6ad35b8 100644 --- a/test-suite/output/ShowMatch.v +++ b/test-suite/output/ShowMatch.v @@ -11,3 +11,4 @@ Module B. Inductive foo := f. (* local foo shadows A.foo, so constructor "f" needs disambiguation *) Show Match A.foo. +End B. diff --git a/test-suite/output/ShowProof.v b/test-suite/output/ShowProof.v index 73ecaf2200..19822ac50e 100644 --- a/test-suite/output/ShowProof.v +++ b/test-suite/output/ShowProof.v @@ -4,3 +4,4 @@ Proof. split. - exact I. Show Proof. (* Was not finding an evar name at some time *) +Abort. diff --git a/test-suite/output/Tactics.v b/test-suite/output/Tactics.v index 75b66e463a..fa12f09a46 100644 --- a/test-suite/output/Tactics.v +++ b/test-suite/output/Tactics.v @@ -21,3 +21,4 @@ Proof. intros H. Fail intros [H%myid ?]. Fail destruct 1 as [H%myid ?]. +Abort. diff --git a/test-suite/output/TypeclassDebug.v b/test-suite/output/TypeclassDebug.v index d38e2a50e4..2e4008ae56 100644 --- a/test-suite/output/TypeclassDebug.v +++ b/test-suite/output/TypeclassDebug.v @@ -6,3 +6,4 @@ Hint Resolve H : foo. Goal foo. Typeclasses eauto := debug. Fail typeclasses eauto 5 with foo. +Abort. diff --git a/test-suite/output/names.v b/test-suite/output/names.v index f1efd0df2a..e9033bd732 100644 --- a/test-suite/output/names.v +++ b/test-suite/output/names.v @@ -7,3 +7,4 @@ Fail Definition b y : {x:nat|x=y} := a y. Goal (forall n m, n <= m -> m <= n -> n = m) -> True. intro H; epose proof (H _ 3) as H. Show. +Abort. diff --git a/test-suite/output/optimize_heap.v b/test-suite/output/optimize_heap.v index e566bd7bab..31b4510397 100644 --- a/test-suite/output/optimize_heap.v +++ b/test-suite/output/optimize_heap.v @@ -5,3 +5,4 @@ Goal True. Show. optimize_heap. Show. +Abort. diff --git a/test-suite/output/rewrite_2172.v b/test-suite/output/rewrite_2172.v index 212b1c1259..864fc21cdd 100644 --- a/test-suite/output/rewrite_2172.v +++ b/test-suite/output/rewrite_2172.v @@ -19,3 +19,4 @@ Proof. user in rewrite/induction/destruct calls). *) Fail rewrite <- axiom. +Abort. diff --git a/test-suite/success/CaseInClause.v b/test-suite/success/CaseInClause.v index 6424fe92dd..ca93c8ea79 100644 --- a/test-suite/success/CaseInClause.v +++ b/test-suite/success/CaseInClause.v @@ -20,6 +20,7 @@ Theorem foo : forall (n m : nat) (pf : n = m), match pf in _ = N with | eq_refl => unit end. +Abort. (* Check redundant clause is removed *) Inductive I : nat * nat -> Type := C : I (0,0). diff --git a/test-suite/success/ImplicitArguments.v b/test-suite/success/ImplicitArguments.v index 9a19b595ef..b16e4a1186 100644 --- a/test-suite/success/ImplicitArguments.v +++ b/test-suite/success/ImplicitArguments.v @@ -27,6 +27,7 @@ Parameters (a:_) (b:a=0). Definition foo6 (x:=1) : forall {n:nat}, n=n := fun n => eq_refl. Fixpoint foo7 (x:=1) (n:nat) {p:nat} {struct n} : nat. +Abort. (* Some example which should succeed with local implicit arguments *) diff --git a/test-suite/success/Print.v b/test-suite/success/Print.v index c4726bf3ff..c1cb86caf1 100644 --- a/test-suite/success/Print.v +++ b/test-suite/success/Print.v @@ -17,3 +17,4 @@ Print Coercion Paths nat Sortclass. Print Section A. +End A. diff --git a/test-suite/success/Scopes.v b/test-suite/success/Scopes.v index 2da630633d..06697af901 100644 --- a/test-suite/success/Scopes.v +++ b/test-suite/success/Scopes.v @@ -25,4 +25,4 @@ Definition c := ε : U. Goal True. assert (nat * nat). - +Abort. diff --git a/test-suite/success/attribute_syntax.v b/test-suite/success/attribute_syntax.v index 241d4eb200..7b972f4ed9 100644 --- a/test-suite/success/attribute_syntax.v +++ b/test-suite/success/attribute_syntax.v @@ -18,6 +18,7 @@ Check ι _ ι. #[program] Fixpoint f (n: nat) {wf lt n} : nat := _. +Reset f. #[deprecated(since="8.9.0")] Ltac foo := foo. diff --git a/test-suite/success/autorewrite.v b/test-suite/success/autorewrite.v index 5e9064f8af..71d333d439 100644 --- a/test-suite/success/autorewrite.v +++ b/test-suite/success/autorewrite.v @@ -27,3 +27,4 @@ Goal forall y, exists x, y+x = y. eexists. autorewrite with base1. Fail reflexivity. +Abort. diff --git a/test-suite/success/change_pattern.v b/test-suite/success/change_pattern.v index 874abf49f1..104585a720 100644 --- a/test-suite/success/change_pattern.v +++ b/test-suite/success/change_pattern.v @@ -32,3 +32,4 @@ clearbody e. if this is not the case because the inferred argument does not coincide with the one in the considered term. *) progress (change (dim (traverse unit a x)) with (dim X) in e). +Abort. diff --git a/test-suite/success/rewrite_evar.v b/test-suite/success/rewrite_evar.v index f7ad261cbb..3bfd3c674a 100644 --- a/test-suite/success/rewrite_evar.v +++ b/test-suite/success/rewrite_evar.v @@ -6,3 +6,4 @@ Goal forall (T2 MT1 MT2 : Type) (x : T2) (M2 m2 : MT2) (M1 m1 : MT1) (F : T2 -> rewrite (H' _) in *. (** The above rewrite should also rewrite in H. *) Fail progress rewrite H' in H. +Abort. diff --git a/test-suite/success/setoid_unif.v b/test-suite/success/setoid_unif.v index 912596b4a3..d579911323 100644 --- a/test-suite/success/setoid_unif.v +++ b/test-suite/success/setoid_unif.v @@ -25,3 +25,4 @@ Goal forall x, ~ In _ x (t Empty). Proof. intros x. rewrite foo. +Abort. diff --git a/test-suite/success/unfold.v b/test-suite/success/unfold.v index de8aa252b8..72f0d94dea 100644 --- a/test-suite/success/unfold.v +++ b/test-suite/success/unfold.v @@ -23,3 +23,4 @@ Goal let x := 0 in True. intro x. Fail (clear x; unfold x). Abort. +End toto. diff --git a/test-suite/success/unidecls.v b/test-suite/success/unidecls.v index c4a1d7c28f..014f1834a2 100644 --- a/test-suite/success/unidecls.v +++ b/test-suite/success/unidecls.v @@ -1,22 +1,22 @@ Set Printing Universes. -Module unidecls. +Module decls. Universes a b. -End unidecls. +End decls. Universe a. -Constraint a < unidecls.a. +Constraint a < decls.a. Print Universes. (** These are different universes *) Check Type@{a}. -Check Type@{unidecls.a}. +Check Type@{decls.a}. -Check Type@{unidecls.b}. +Check Type@{decls.b}. -Fail Check Type@{unidecls.c}. +Fail Check Type@{decls.c}. Fail Check Type@{i}. Universe foo. -- cgit v1.2.3 From d19372209eca556bb07116b518d8740ff6385035 Mon Sep 17 00:00:00 2001 From: Vincent Laporte Date: Wed, 3 Oct 2018 14:02:51 +0000 Subject: Test-suite: avoid explicit references to “Top” --- test-suite/bugs/closed/bug_5096.v | 15 ++++---- test-suite/modules/modeq.v | 5 +-- test-suite/modules/modul.v | 3 +- test-suite/output/Arguments.out | 16 ++++----- test-suite/output/Arguments.v | 1 + test-suite/output/ArgumentsScope.out | 12 +++---- test-suite/output/ArgumentsScope.v | 1 + test-suite/output/Arguments_renaming.out | 10 +++--- test-suite/output/Arguments_renaming.v | 1 + test-suite/output/Errors.out | 2 +- test-suite/output/Errors.v | 1 + test-suite/output/Nametab.out | 59 +++++++++++++++++--------------- test-suite/output/Nametab.v | 17 ++++----- test-suite/output/PrintInfos.out | 2 +- test-suite/output/PrintInfos.v | 1 + test-suite/output/UnivBinders.out | 40 ++++++++++++---------- test-suite/output/UnivBinders.v | 11 +++--- test-suite/output/qualification.out | 5 +-- test-suite/output/qualification.v | 1 + test-suite/success/unidecls.v | 3 +- 20 files changed, 112 insertions(+), 94 deletions(-) diff --git a/test-suite/bugs/closed/bug_5096.v b/test-suite/bugs/closed/bug_5096.v index 20a537ab3c..18ce5c7305 100644 --- a/test-suite/bugs/closed/bug_5096.v +++ b/test-suite/bugs/closed/bug_5096.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "bug_5096") *) Require Import Coq.FSets.FMapPositive Coq.PArith.BinPos Coq.Lists.List. Set Asymmetric Patterns. @@ -81,14 +82,14 @@ Global Arguments register_reassign {_ _ _ _} ctxi ctxr e _. Section language5. Context (Name : Type). - Local Notation expr := (@Top.expr Name). + Local Notation expr := (@bug_5096.expr Name). Local Notation nexpr := (@Named.expr Name). Fixpoint ocompile (e : expr) (ls : list (option Name)) {struct e} : option (nexpr) - := match e in @Top.expr _ return option (nexpr) with - | Top.Const => Some Named.Const - | Top.LetIn ex eC + := match e in @bug_5096.expr _ return option (nexpr) with + | bug_5096.Const => Some Named.Const + | bug_5096.LetIn ex eC => match @ocompile ex nil, split_onames ls with | Some x, (Some n, ls')%core => option_map (fun C => Named.LetIn n x C) (@ocompile (eC n) ls') @@ -189,8 +190,8 @@ Definition DefaultRegisters (e : Expr) : list Register Definition DefaultAssembleSyntax e := @AssembleSyntax e (DefaultRegisters e). -Notation "'slet' x := A 'in' b" := (Top.LetIn A (fun x => b)) (at level 200, b at level 200). -Notation "#[ var ]#" := (@Top.Const var). +Notation "'slet' x := A 'in' b" := (bug_5096.LetIn A (fun x => b)) (at level 200, b at level 200). +Notation "#[ var ]#" := (@bug_5096.Const var). Definition compiled_syntax : Expr := fun (var : Type) => ( @@ -211,7 +212,7 @@ Definition compiled_syntax : Expr := fun (var : Type) => slet x1 := #[ var ]# in slet x1 := #[ var ]# in slet x1 := #[ var ]# in - @Top.Const var). + @bug_5096.Const var). Definition v := Eval cbv [compiled_syntax] in (DefaultAssembleSyntax (compiled_syntax)). diff --git a/test-suite/modules/modeq.v b/test-suite/modules/modeq.v index c8129eec5e..4ebcae82e5 100644 --- a/test-suite/modules/modeq.v +++ b/test-suite/modules/modeq.v @@ -1,10 +1,11 @@ +(* coq-prog-args: ("-top" "modeq") *) Module M. Definition T := nat. Definition x : T := 0. End M. Module Type SIG. - Module M := Top.M. + Module M := modeq.M. Module Type SIG. Parameter T : Set. End SIG. @@ -12,7 +13,7 @@ Module Type SIG. End SIG. Module Z. - Module M := Top.M. + Module M := modeq.M. Module Type SIG. Parameter T : Set. End SIG. diff --git a/test-suite/modules/modul.v b/test-suite/modules/modul.v index 36a542ef0a..9b3772b0d9 100644 --- a/test-suite/modules/modul.v +++ b/test-suite/modules/modul.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "modul") *) Module M. Parameter rel : nat -> nat -> Prop. @@ -32,4 +33,4 @@ Locate rel. Locate Module M. -Module N := Top.M. +Module N := modul.M. diff --git a/test-suite/output/Arguments.out b/test-suite/output/Arguments.out index 979396969a..d587d1f09b 100644 --- a/test-suite/output/Arguments.out +++ b/test-suite/output/Arguments.out @@ -42,32 +42,32 @@ Arguments D1, C1 are implicit and maximally inserted Argument scopes are [foo_scope type_scope _ _ _ _ _] The reduction tactics never unfold pf pf is transparent -Expands to: Constant Top.pf +Expands to: Constant Arguments.pf fcomp : forall A B C : Type, (B -> C) -> (A -> B) -> A -> C Arguments A, B, C are implicit and maximally inserted Argument scopes are [type_scope type_scope type_scope _ _ _] The reduction tactics unfold fcomp when applied to 6 arguments fcomp is transparent -Expands to: Constant Top.fcomp +Expands to: Constant Arguments.fcomp volatile : nat -> nat Argument scope is [nat_scope] The reduction tactics always unfold volatile volatile is transparent -Expands to: Constant Top.volatile +Expands to: Constant Arguments.volatile f : T1 -> T2 -> nat -> unit -> nat -> nat Argument scopes are [_ _ nat_scope _ nat_scope] f is transparent -Expands to: Constant Top.S1.S2.f +Expands to: Constant Arguments.S1.S2.f f : T1 -> T2 -> nat -> unit -> nat -> nat Argument scopes are [_ _ nat_scope _ nat_scope] The reduction tactics unfold f when the 3rd, 4th and 5th arguments evaluate to a constructor f is transparent -Expands to: Constant Top.S1.S2.f +Expands to: Constant Arguments.S1.S2.f f : forall T2 : Type, T1 -> T2 -> nat -> unit -> nat -> nat Argument T2 is implicit @@ -75,7 +75,7 @@ Argument scopes are [type_scope _ _ nat_scope _ nat_scope] The reduction tactics unfold f when the 4th, 5th and 6th arguments evaluate to a constructor f is transparent -Expands to: Constant Top.S1.f +Expands to: Constant Arguments.S1.f f : forall T1 T2 : Type, T1 -> T2 -> nat -> unit -> nat -> nat Arguments T1, T2 are implicit @@ -83,7 +83,7 @@ Argument scopes are [type_scope type_scope _ _ nat_scope _ nat_scope] The reduction tactics unfold f when the 5th, 6th and 7th arguments evaluate to a constructor f is transparent -Expands to: Constant Top.f +Expands to: Constant Arguments.f = forall v : unit, f 0 0 5 v 3 = 2 : Prop = 2 = 2 @@ -93,7 +93,7 @@ f : forall T1 T2 : Type, T1 -> T2 -> nat -> unit -> nat -> nat The reduction tactics unfold f when the 5th, 6th and 7th arguments evaluate to a constructor f is transparent -Expands to: Constant Top.f +Expands to: Constant Arguments.f forall w : r, w 3 true = tt : Prop The command has indeed failed with message: diff --git a/test-suite/output/Arguments.v b/test-suite/output/Arguments.v index b67ac4f0df..97df40f882 100644 --- a/test-suite/output/Arguments.v +++ b/test-suite/output/Arguments.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "Arguments") *) Arguments Nat.sub n m : simpl nomatch. About Nat.sub. Arguments Nat.sub n / m : simpl nomatch. diff --git a/test-suite/output/ArgumentsScope.out b/test-suite/output/ArgumentsScope.out index 6643c1429a..febe160820 100644 --- a/test-suite/output/ArgumentsScope.out +++ b/test-suite/output/ArgumentsScope.out @@ -10,12 +10,12 @@ negb'' : bool -> bool Argument scope is [bool_scope] negb'' is transparent -Expands to: Constant Top.A.B.negb'' +Expands to: Constant ArgumentsScope.A.B.negb'' negb' : bool -> bool Argument scope is [bool_scope] negb' is transparent -Expands to: Constant Top.A.negb' +Expands to: Constant ArgumentsScope.A.negb' negb : bool -> bool Argument scope is [bool_scope] @@ -34,11 +34,11 @@ Expands to: Constant Coq.Init.Datatypes.negb negb' : bool -> bool negb' is transparent -Expands to: Constant Top.A.negb' +Expands to: Constant ArgumentsScope.A.negb' negb'' : bool -> bool negb'' is transparent -Expands to: Constant Top.A.B.negb'' +Expands to: Constant ArgumentsScope.A.B.negb'' a : bool -> bool Expands to: Variable a @@ -49,8 +49,8 @@ Expands to: Constant Coq.Init.Datatypes.negb negb' : bool -> bool negb' is transparent -Expands to: Constant Top.negb' +Expands to: Constant ArgumentsScope.negb' negb'' : bool -> bool negb'' is transparent -Expands to: Constant Top.negb'' +Expands to: Constant ArgumentsScope.negb'' diff --git a/test-suite/output/ArgumentsScope.v b/test-suite/output/ArgumentsScope.v index 3a90cb79d7..ec49d85161 100644 --- a/test-suite/output/ArgumentsScope.v +++ b/test-suite/output/ArgumentsScope.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "ArgumentsScope") *) (* A few tests to check Global Argument Scope command *) Section A. diff --git a/test-suite/output/Arguments_renaming.out b/test-suite/output/Arguments_renaming.out index c0b04eb53f..1755886967 100644 --- a/test-suite/output/Arguments_renaming.out +++ b/test-suite/output/Arguments_renaming.out @@ -1,6 +1,6 @@ The command has indeed failed with message: Flag "rename" expected to rename A into B. -File "stdin", line 2, characters 0-25: +File "stdin", line 3, characters 0-25: Warning: This command is just asserting the names of arguments of identity. If this is what you want add ': assert' to silence the warning. If you want to clear implicit arguments add ': clear implicits'. If you want to clear @@ -41,7 +41,7 @@ myrefl : forall (B : Type) (x : A), B -> myEq B x x Arguments are renamed to C, x, _ Argument C is implicit and maximally inserted Argument scopes are [type_scope _ _] -Expands to: Constructor Top.Test1.myrefl +Expands to: Constructor Arguments_renaming.Test1.myrefl myplus = fix myplus (T : Type) (t : T) (n m : nat) {struct n} : nat := match n with @@ -61,7 +61,7 @@ Argument scopes are [type_scope _ nat_scope nat_scope] The reduction tactics unfold myplus when the 2nd and 3rd arguments evaluate to a constructor myplus is transparent -Expands to: Constant Top.Test1.myplus +Expands to: Constant Arguments_renaming.Test1.myplus @myplus : forall Z : Type, Z -> nat -> nat -> nat Inductive myEq (A B : Type) (x : A) : A -> Prop := @@ -76,7 +76,7 @@ myrefl : forall (A B : Type) (x : A), B -> myEq A B x x Arguments are renamed to A, C, x, _ Argument C is implicit and maximally inserted Argument scopes are [type_scope type_scope _ _] -Expands to: Constructor Top.myrefl +Expands to: Constructor Arguments_renaming.myrefl myrefl : forall (A C : Type) (x : A), C -> myEq A C x x myplus = @@ -98,7 +98,7 @@ Argument scopes are [type_scope _ nat_scope nat_scope] The reduction tactics unfold myplus when the 2nd and 3rd arguments evaluate to a constructor myplus is transparent -Expands to: Constant Top.myplus +Expands to: Constant Arguments_renaming.myplus @myplus : forall Z : Type, Z -> nat -> nat -> nat The command has indeed failed with message: diff --git a/test-suite/output/Arguments_renaming.v b/test-suite/output/Arguments_renaming.v index 0cb331347d..9713a9dbbe 100644 --- a/test-suite/output/Arguments_renaming.v +++ b/test-suite/output/Arguments_renaming.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "Arguments_renaming") *) Fail Arguments eq_refl {B y}, [B] y. Arguments identity A _ _. Arguments eq_refl A x : assert. diff --git a/test-suite/output/Errors.out b/test-suite/output/Errors.out index 24180c4553..cf2d5b2850 100644 --- a/test-suite/output/Errors.out +++ b/test-suite/output/Errors.out @@ -1,5 +1,5 @@ The command has indeed failed with message: -The field t is missing in Top.M. +The field t is missing in Errors.M. The command has indeed failed with message: Unable to unify "nat" with "True". The command has indeed failed with message: diff --git a/test-suite/output/Errors.v b/test-suite/output/Errors.v index 7375227827..edc35f17b4 100644 --- a/test-suite/output/Errors.v +++ b/test-suite/output/Errors.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "Errors") *) (* Test error messages *) (* Test non-regression of bug fixed in r13486 (bad printer for module names) *) diff --git a/test-suite/output/Nametab.out b/test-suite/output/Nametab.out index c11621d7c1..47b19b71b3 100644 --- a/test-suite/output/Nametab.out +++ b/test-suite/output/Nametab.out @@ -1,36 +1,39 @@ -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) -Constant Top.Q.N.K.foo -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) -Module Top.Q.N.K (shorter name to refer to it in current context is Q.N.K) -Module Top.Q.N.K (shorter name to refer to it in current context is Q.N.K) -Module Top.Q.N.K -Module Top.Q.N.K (shorter name to refer to it in current context is Q.N.K) -Module Top.Q.N (shorter name to refer to it in current context is Q.N) -Module Top.Q.N -Module Top.Q.N (shorter name to refer to it in current context is Q.N) -Module Top.Q -Module Top.Q (shorter name to refer to it in current context is Q) -Constant Top.Q.N.K.foo +Module Nametab.Q.N.K + (shorter name to refer to it in current context is Q.N.K) +Module Nametab.Q.N.K + (shorter name to refer to it in current context is Q.N.K) +Module Nametab.Q.N.K +Module Nametab.Q.N.K + (shorter name to refer to it in current context is Q.N.K) +Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) +Module Nametab.Q.N +Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) +Module Nametab.Q +Module Nametab.Q (shorter name to refer to it in current context is Q) +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) -Constant Top.Q.N.K.foo -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) -Module Top.Q.N.K -Module Top.Q.N.K (shorter name to refer to it in current context is K) -Module Top.Q.N.K (shorter name to refer to it in current context is K) -Module Top.Q.N.K (shorter name to refer to it in current context is K) -Module Top.Q.N (shorter name to refer to it in current context is Q.N) -Module Top.Q.N -Module Top.Q.N (shorter name to refer to it in current context is Q.N) -Module Top.Q -Module Top.Q (shorter name to refer to it in current context is Q) +Module Nametab.Q.N.K +Module Nametab.Q.N.K (shorter name to refer to it in current context is K) +Module Nametab.Q.N.K (shorter name to refer to it in current context is K) +Module Nametab.Q.N.K (shorter name to refer to it in current context is K) +Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) +Module Nametab.Q.N +Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) +Module Nametab.Q +Module Nametab.Q (shorter name to refer to it in current context is Q) diff --git a/test-suite/output/Nametab.v b/test-suite/output/Nametab.v index 357ba98243..4bbc5ca239 100644 --- a/test-suite/output/Nametab.v +++ b/test-suite/output/Nametab.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "Nametab") *) Module Q. Module N. Module K. @@ -10,19 +11,19 @@ End Q. (* Bad *) Locate K.foo. (* Bad *) Locate N.K.foo. (* OK *) Locate Q.N.K.foo. -(* OK *) Locate Top.Q.N.K.foo. +(* OK *) Locate Nametab.Q.N.K.foo. (* Bad *) Locate Module K. (* Bad *) Locate Module N.K. (* OK *) Locate Module Q.N.K. -(* OK *) Locate Module Top.Q.N.K. +(* OK *) Locate Module Nametab.Q.N.K. (* Bad *) Locate Module N. (* OK *) Locate Module Q.N. -(* OK *) Locate Module Top.Q.N. +(* OK *) Locate Module Nametab.Q.N. (* OK *) Locate Module Q. -(* OK *) Locate Module Top.Q. +(* OK *) Locate Module Nametab.Q. Import Q.N. @@ -32,16 +33,16 @@ Import Q.N. (* OK *) Locate K.foo. (* Bad *) Locate N.K.foo. (* OK *) Locate Q.N.K.foo. -(* OK *) Locate Top.Q.N.K.foo. +(* OK *) Locate Nametab.Q.N.K.foo. (* OK *) Locate Module K. (* Bad *) Locate Module N.K. (* OK *) Locate Module Q.N.K. -(* OK *) Locate Module Top.Q.N.K. +(* OK *) Locate Module Nametab.Q.N.K. (* Bad *) Locate Module N. (* OK *) Locate Module Q.N. -(* OK *) Locate Module Top.Q.N. +(* OK *) Locate Module Nametab.Q.N. (* OK *) Locate Module Q. -(* OK *) Locate Module Top.Q. +(* OK *) Locate Module Nametab.Q. diff --git a/test-suite/output/PrintInfos.out b/test-suite/output/PrintInfos.out index 975b2ef7ff..38a16e01c2 100644 --- a/test-suite/output/PrintInfos.out +++ b/test-suite/output/PrintInfos.out @@ -77,7 +77,7 @@ Expanded type for implicit arguments bar : forall x : nat, x = 0 Argument x is implicit and maximally inserted -Expands to: Constant Top.bar +Expands to: Constant PrintInfos.bar *** [ bar : foo ] Expanded type for implicit arguments diff --git a/test-suite/output/PrintInfos.v b/test-suite/output/PrintInfos.v index 62aa80f8ab..d7c271c3ec 100644 --- a/test-suite/output/PrintInfos.v +++ b/test-suite/output/PrintInfos.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "PrintInfos") *) About existT. Print existT. Print Implicit existT. diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out index 1e50ba511a..acc37f653c 100644 --- a/test-suite/output/UnivBinders.out +++ b/test-suite/output/UnivBinders.out @@ -42,10 +42,10 @@ bar@{u} = nat *) bar is universe polymorphic -foo@{u Top.17 v} = -Type@{Top.17} -> Type@{v} -> Type@{u} - : Type@{max(u+1,Top.17+1,v+1)} -(* u Top.17 v |= *) +foo@{u UnivBinders.17 v} = +Type@{UnivBinders.17} -> Type@{v} -> Type@{u} + : Type@{max(u+1,UnivBinders.17+1,v+1)} +(* u UnivBinders.17 v |= *) foo is universe polymorphic Type@{i} -> Type@{j} @@ -86,10 +86,10 @@ Type@{M} -> Type@{N} -> Type@{E} (* E M N |= *) foo is universe polymorphic -foo@{u Top.17 v} = -Type@{Top.17} -> Type@{v} -> Type@{u} - : Type@{max(u+1,Top.17+1,v+1)} -(* u Top.17 v |= *) +foo@{u UnivBinders.17 v} = +Type@{UnivBinders.17} -> Type@{v} -> Type@{u} + : Type@{max(u+1,UnivBinders.17+1,v+1)} +(* u UnivBinders.17 v |= *) foo is universe polymorphic NonCumulative Inductive Empty@{E} : Type@{E} := @@ -104,7 +104,7 @@ punwrap@{K} : forall A : Type@{K}, PWrap@{K} A -> A punwrap is universe polymorphic Argument scopes are [type_scope _] punwrap is transparent -Expands to: Constant Top.punwrap +Expands to: Constant UnivBinders.punwrap The command has indeed failed with message: Universe instance should have length 3 The command has indeed failed with message: @@ -163,27 +163,29 @@ inmod@{u} -> Type@{v} (* u v |= *) Applied.infunct is universe polymorphic -axfoo@{i Top.55 Top.56} : Type@{Top.55} -> Type@{i} -(* i Top.55 Top.56 |= *) +axfoo@{i UnivBinders.55 UnivBinders.56} : +Type@{UnivBinders.55} -> Type@{i} +(* i UnivBinders.55 UnivBinders.56 |= *) axfoo is universe polymorphic Argument scope is [type_scope] -Expands to: Constant Top.axfoo -axbar@{i Top.55 Top.56} : Type@{Top.56} -> Type@{i} -(* i Top.55 Top.56 |= *) +Expands to: Constant UnivBinders.axfoo +axbar@{i UnivBinders.55 UnivBinders.56} : +Type@{UnivBinders.56} -> Type@{i} +(* i UnivBinders.55 UnivBinders.56 |= *) axbar is universe polymorphic Argument scope is [type_scope] -Expands to: Constant Top.axbar -axfoo' : Type@{Top.58} -> Type@{axbar'.i} +Expands to: Constant UnivBinders.axbar +axfoo' : Type@{UnivBinders.58} -> Type@{axbar'.i} axfoo' is not universe polymorphic Argument scope is [type_scope] -Expands to: Constant Top.axfoo' -axbar' : Type@{Top.58} -> Type@{axbar'.i} +Expands to: Constant UnivBinders.axfoo' +axbar' : Type@{UnivBinders.58} -> Type@{axbar'.i} axbar' is not universe polymorphic Argument scope is [type_scope] -Expands to: Constant Top.axbar' +Expands to: Constant UnivBinders.axbar' The command has indeed failed with message: When declaring multiple axioms in one command, only the first is allowed a universe binder (which will be shared by the whole block). diff --git a/test-suite/output/UnivBinders.v b/test-suite/output/UnivBinders.v index 9aebce1b9a..56474a0723 100644 --- a/test-suite/output/UnivBinders.v +++ b/test-suite/output/UnivBinders.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "UnivBinders") *) Set Universe Polymorphism. Set Printing Universes. (* Unset Strict Universe Declaration. *) @@ -58,7 +59,7 @@ Import mono. Check monomono. (* unqualified MONOU *) Check mono. (* still qualified mono.u *) -Monomorphic Constraint Set < Top.mono.u. +Monomorphic Constraint Set < UnivBinders.mono.u. Module mono2. Monomorphic Universe u. @@ -76,10 +77,10 @@ Module SecLet. Definition bobmorane := tt -> ff. End foo. Print bobmorane. (* - bobmorane@{Top.15 Top.16 ff.u ff.v} = - let tt := Type@{Top.16} in let ff := Type@{ff.v} in tt -> ff - : Type@{max(Top.15,ff.u)} - (* Top.15 Top.16 ff.u ff.v |= Top.16 < Top.15 + bobmorane@{UnivBinders.15 UnivBinders.16 ff.u ff.v} = + let tt := Type@{UnivBinders.16} in let ff := Type@{ff.v} in tt -> ff + : Type@{max(UnivBinders.15,ff.u)} + (* UnivBinders.15 UnivBinders.16 ff.u ff.v |= UnivBinders.16 < UnivBinders.15 ff.v < ff.u *) diff --git a/test-suite/output/qualification.out b/test-suite/output/qualification.out index e9c70d1efc..cfa295010f 100644 --- a/test-suite/output/qualification.out +++ b/test-suite/output/qualification.out @@ -1,4 +1,5 @@ -File "stdin", line 19, characters 0-7: +File "stdin", line 20, characters 0-7: Error: Signature components for label test do not match: expected type -"Top.M2.t = Top.M2.M.t" but found type "Top.M2.t = Top.M2.t". +"qualification.M2.t = qualification.M2.M.t" but found type +"qualification.M2.t = qualification.M2.t". diff --git a/test-suite/output/qualification.v b/test-suite/output/qualification.v index d39097e2dd..877bc84d14 100644 --- a/test-suite/output/qualification.v +++ b/test-suite/output/qualification.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "qualification") *) Module Type T1. Parameter t : Type. End T1. diff --git a/test-suite/success/unidecls.v b/test-suite/success/unidecls.v index 014f1834a2..7c298c98b6 100644 --- a/test-suite/success/unidecls.v +++ b/test-suite/success/unidecls.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "unidecls") *) Set Printing Universes. Module decls. @@ -39,7 +40,7 @@ Check Type@{Foo.bar}. Check Type@{Foo.foo}. (** The same *) Check Type@{foo}. -Check Type@{Top.foo}. +Check Type@{unidecls.foo}. Universe secfoo. Section Foo'. -- cgit v1.2.3