foo.adb 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103
  1. -- Copyright 2018-2022 Free Software Foundation, Inc.
  2. --
  3. -- This program is free software; you can redistribute it and/or modify
  4. -- it under the terms of the GNU General Public License as published by
  5. -- the Free Software Foundation; either version 3 of the License, or
  6. -- (at your option) any later version.
  7. --
  8. -- This program is distributed in the hope that it will be useful,
  9. -- but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. -- GNU General Public License for more details.
  12. --
  13. -- You should have received a copy of the GNU General Public License
  14. -- along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. with Pck; use Pck;
  16. procedure Foo is
  17. begin
  18. -- Part 1 of the testcase
  19. begin
  20. raise Constraint_Error;
  21. exception
  22. when Constraint_Error =>
  23. null;
  24. end;
  25. begin
  26. null;
  27. exception
  28. when others =>
  29. null;
  30. end;
  31. begin
  32. raise Storage_Error;
  33. exception
  34. when Storage_Error =>
  35. null;
  36. end;
  37. -- Part 2 of the testcase
  38. begin
  39. raise ABORT_SIGNAL;
  40. exception
  41. when others =>
  42. null;
  43. end;
  44. begin
  45. raise Program_Error;
  46. exception
  47. when Program_Error =>
  48. null;
  49. end;
  50. begin
  51. raise Storage_Error;
  52. exception
  53. when Storage_Error =>
  54. null;
  55. end;
  56. -- Part 3 of the testcase
  57. begin
  58. Global_Var := Global_Var + 1;
  59. raise ABORT_SIGNAL;
  60. exception
  61. when others =>
  62. null;
  63. end;
  64. begin
  65. Global_Var := Global_Var + 1;
  66. raise Constraint_Error;
  67. exception
  68. when Constraint_Error =>
  69. null;
  70. end;
  71. -- Part 4 of the testcase
  72. begin
  73. Global_Var := Global_Var + 1;
  74. raise Program_Error;
  75. exception
  76. when others =>
  77. null;
  78. end;
  79. begin
  80. Global_Var := Global_Var + 1;
  81. raise Program_Error;
  82. exception
  83. when Program_Error =>
  84. null;
  85. end;
  86. end Foo;