From 718364340fa052641189523e41a5006ba6c9966d Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 7 Jul 2018 10:06:08 +0000 Subject: [PATCH] decl.c (gnat_to_gnu_param): Minor tweak. * gcc-interface/decl.c (gnat_to_gnu_param): Minor tweak. (gnat_to_gnu_subprog_type): New pure_flag local variable. Set it for a pure Ada function with a by-ref In parameter. Propagate it onto the function type by means of the TYPE_QUAL_RESTRICT flag. * gcc-interface/utils.c (finish_subprog_decl): Set DECL_PURE_P if the function type has the TYPE_QUAL_RESTRICT flag set. From-SVN: r262495 --- gcc/ada/ChangeLog | 9 +++++ gcc/ada/gcc-interface/decl.c | 36 +++++++++++++------- gcc/ada/gcc-interface/utils.c | 3 ++ gcc/testsuite/ChangeLog | 7 ++++ gcc/testsuite/gnat.dg/pure_function3_pkg.ads | 14 ++++++++ gcc/testsuite/gnat.dg/pure_function3a.adb | 16 +++++++++ gcc/testsuite/gnat.dg/pure_function3b.adb | 18 ++++++++++ gcc/testsuite/gnat.dg/pure_function3c.adb | 16 +++++++++ 8 files changed, 106 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/pure_function3_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/pure_function3a.adb create mode 100644 gcc/testsuite/gnat.dg/pure_function3b.adb create mode 100644 gcc/testsuite/gnat.dg/pure_function3c.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3ae83a70198..c5cf06c4cdd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2018-07-07 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_param): Minor tweak. + (gnat_to_gnu_subprog_type): New pure_flag local variable. Set it for + a pure Ada function with a by-ref In parameter. Propagate it onto the + function type by means of the TYPE_QUAL_RESTRICT flag. + * gcc-interface/utils.c (finish_subprog_decl): Set DECL_PURE_P if the + function type has the TYPE_QUAL_RESTRICT flag set. + 2018-07-06 Jim Wilson * Makefile.rtl: Add riscv*-linux* support. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 82a44922c18..def48f16974 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5228,7 +5228,6 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_param_type))) gnu_param_type = TREE_TYPE (gnu_param_type); - by_component_ptr = true; gnu_param_type = TREE_TYPE (gnu_param_type); if (ro_param) @@ -5236,6 +5235,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, = change_qualified_type (gnu_param_type, TYPE_QUAL_CONST); gnu_param_type = build_pointer_type (gnu_param_type); + by_component_ptr = true; } /* Fat pointers are passed as thin pointers for foreign conventions. */ @@ -5561,14 +5561,15 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, /* Fields in return type of procedure with copy-in copy-out parameters. */ tree gnu_field_list = NULL_TREE; /* 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 if the EH circuitry is explicit in the - internal representation of the back-end. If we are to completely + or "pure" in GCC. In particular, both properties are orthogonal + to the "nothrow" property if the EH circuitry is explicit in the + internal representation of the middle-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. */ + trigger an "abnormal" transfer of control flow; therefore, they can + be neither "const" nor "pure" in the GCC sense. */ bool const_flag = (Back_End_Exceptions () && Is_Pure (gnat_subprog)); + bool pure_flag = false; bool return_by_direct_ref_p = false; bool return_by_invisi_ref_p = false; bool return_unconstrained_p = false; @@ -5849,13 +5850,19 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, gnu_param_list = chainon (gnu_param, gnu_param_list); save_gnu_tree (gnat_param, gnu_param, false); - /* If a parameter is a pointer, a function may modify memory through - it and thus shouldn't be considered a const function. Also, the - memory may be modified between two calls, so they can't be CSE'ed. - The latter case also handles by-ref parameters. */ - if (POINTER_TYPE_P (gnu_param_type) - || TYPE_IS_FAT_POINTER_P (gnu_param_type)) - const_flag = false; + /* A pure function in the Ada sense which takes an access parameter + may modify memory through it and thus need be considered neither + const nor pure in the GCC sense. Likewise it if takes a by-ref + In Out or Out parameter. But if it takes a by-ref In parameter, + then it may only read memory through it and can be considered + pure in the GCC sense. */ + if ((const_flag || pure_flag) + && (POINTER_TYPE_P (gnu_param_type) + || TYPE_IS_FAT_POINTER_P (gnu_param_type))) + { + const_flag = false; + pure_flag = DECL_POINTS_TO_READONLY_P (gnu_param); + } } /* If the parameter uses the copy-in copy-out mechanism, allocate a field @@ -6007,6 +6014,9 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, if (const_flag) gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_CONST); + if (pure_flag) + gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_RESTRICT); + if (No_Return (gnat_subprog)) gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE); diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index e456cc63373..e0e5cfe4de2 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -3330,6 +3330,9 @@ finish_subprog_decl (tree decl, tree asm_name, tree type) /* Propagate the "const" property. */ TREE_READONLY (decl) = TYPE_READONLY (type); + /* Propagate the "pure" property. */ + DECL_PURE_P (decl) = TYPE_RESTRICT (type); + /* Propagate the "noreturn" property. */ TREE_THIS_VOLATILE (decl) = TYPE_VOLATILE (type); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f9a74ac6db7..f8a33d809b3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2018-07-07 Eric Botcazou + + * gnat.dg/pure_function3a.adb: New test. + * gnat.dg/pure_function3b.adb: Likewise. + * gnat.dg/pure_function3c.adb: Likewise. + * gnat.dg/pure_function3_pkg.ads: New helper. + 2018-07-07 Jakub Jelinek PR target/84711 diff --git a/gcc/testsuite/gnat.dg/pure_function3_pkg.ads b/gcc/testsuite/gnat.dg/pure_function3_pkg.ads new file mode 100644 index 00000000000..62ad9d29105 --- /dev/null +++ b/gcc/testsuite/gnat.dg/pure_function3_pkg.ads @@ -0,0 +1,14 @@ +package Pure_Function3_Pkg is + + type T is limited private; + function F (Self : T) return Integer with Pure_Function; + procedure Set (Self : in out T); + function F_And_Set (Self : in out T) return Integer with Pure_Function; + +private + + type T is limited record + F : Integer; + end record; + +end Pure_Function3_Pkg; diff --git a/gcc/testsuite/gnat.dg/pure_function3a.adb b/gcc/testsuite/gnat.dg/pure_function3a.adb new file mode 100644 index 00000000000..879c6bc2b6c --- /dev/null +++ b/gcc/testsuite/gnat.dg/pure_function3a.adb @@ -0,0 +1,16 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatws -fdump-tree-optimized" } + +with Pure_Function3_Pkg; use Pure_Function3_Pkg; + +procedure Pure_Function3a is + V : T; +begin + if F (V) = 1 then + raise Program_Error; + elsif F (V) = 2 then + raise Program_Error; + end if; +end; + +-- { dg-final { scan-tree-dump-times "pure_function3_pkg.f" 1 "optimized" } } diff --git a/gcc/testsuite/gnat.dg/pure_function3b.adb b/gcc/testsuite/gnat.dg/pure_function3b.adb new file mode 100644 index 00000000000..97e19fcd2e4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/pure_function3b.adb @@ -0,0 +1,18 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatws -fdump-tree-optimized" } + +with Pure_Function3_Pkg; use Pure_Function3_Pkg; + +procedure Pure_Function3b is + V : T; +begin + if F (V) = 1 then + raise Program_Error; + end if; + Set (V); + if F (V) = 2 then + raise Program_Error; + end if; +end; + +-- { dg-final { scan-tree-dump-times "pure_function3_pkg.f" 2 "optimized" } } diff --git a/gcc/testsuite/gnat.dg/pure_function3c.adb b/gcc/testsuite/gnat.dg/pure_function3c.adb new file mode 100644 index 00000000000..0e3ec81d142 --- /dev/null +++ b/gcc/testsuite/gnat.dg/pure_function3c.adb @@ -0,0 +1,16 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatws -fdump-tree-optimized" } + +with Pure_Function3_Pkg; use Pure_Function3_Pkg; + +procedure Pure_Function3c is + V : T; +begin + if F_And_Set (V) = 1 then + raise Program_Error; + elsif F_And_Set (V) = 2 then + raise Program_Error; + end if; +end; + +-- { dg-final { scan-tree-dump-times "pure_function3_pkg.f" 2 "optimized" } } -- 2.30.2