+2008-08-01 Olivier Hainque <hainque@adacore.com>
+
+ * decl.c (gnat_to_gnu_entity) <case E_Function>: Do not turn Ada
+ Pure into GCC const, now implicitely implying nothrow as well.
+
2008-08-01 Robert Dewar <dewar@adacore.com>
* sem_prag.adb (Check_Form_Of_Interface_Name): Refine and improve
if (TREE_CODE (gnu_return_type) == VOID_TYPE)
pure_flag = false;
- /* The semantics of "pure" in Ada essentially matches that of "const"
- in the back-end. In particular, both properties are orthogonal to
- the "nothrow" property. But this is true only if the EH circuitry
- is explicit in the internal representation of the back-end. If we
- are to completely hide the EH circuitry from it, we need to declare
- that calls to pure Ada subprograms that can throw have side effects
- since they can trigger an "abnormal" transfer of control flow; thus
- they can be neither "const" nor "pure" in the back-end sense. */
+ /* The semantics of "pure" in Ada used to essentially match that of
+ "const" in the middle-end. In particular, both properties were
+ orthogonal to the "nothrow" property. This is not true in the
+ middle-end any more and we have no choice but to ignore the hint
+ at this stage. */
+
gnu_type
= build_qualified_type (gnu_type,
TYPE_QUALS (gnu_type)
- | (Exception_Mechanism == Back_End_Exceptions
- ? TYPE_QUAL_CONST * pure_flag : 0)
| (TYPE_QUAL_VOLATILE * volatile_flag));
Sloc_to_locus (Sloc (gnat_entity), &input_location);
+2008-08-01 Olivier Hainque <hainque@adacore.com>
+
+ * gnat.dg/raise_from_pure.ad[bs],
+ * gnat.dg/wrap_raise_from_pure.ad[bs]: Support for ...
+ * gnat.dg/test_raise_from_pure.adb: New test.
+
2008-07-31 Adam Nemet <anemet@caviumnetworks.com>
* gcc.target/mips/ext-1.c: New test.
--- /dev/null
+package body raise_from_pure is
+ function Raise_CE_If_0 (P : Integer) return Integer is
+ begin
+ if P = 0 then
+ raise Constraint_error;
+ end if;
+ return 1;
+ end;
+end;
+
+
--- /dev/null
+
+package raise_from_pure is
+ pragma Pure;
+ function Raise_CE_If_0 (P : Integer) return Integer;
+end;
--- /dev/null
+-- { dg-do run }
+-- { dg-options "-O2" }
+with Wrap_Raise_From_Pure; use Wrap_Raise_From_Pure;
+procedure test_raise_from_pure is
+begin
+ Wrap_Raise_From_Pure.Check;
+exception
+ when Constraint_Error => null;
+end;
--- /dev/null
+with Ada.Text_Io; use Ada.Text_Io;
+with Raise_From_Pure; use Raise_From_Pure;
+package body Wrap_Raise_From_Pure is
+ procedure Check is
+ K : Integer;
+ begin
+ K := Raise_CE_If_0 (0);
+ Put_Line ("Should never reach here");
+ end;
+end;
--- /dev/null
+
+package Wrap_Raise_From_Pure is
+ procedure Check;
+end;