From: pmderodat Date: Tue, 11 Dec 2018 11:10:27 +0000 (+0000) Subject: [Ada] Complete implementation of RM C.6(19) clause X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=a6d5dfca9387cdfb72e320d101337d8604a4abde;p=thirdparty%2Fgcc.git [Ada] Complete implementation of RM C.6(19) clause This ensures that the compiler fully implements the C.6(19) clause of the Ada Reference Manual and gives a warning when the clause does change the passing mechanism of the affected parameter. 2018-12-11 Eric Botcazou gcc/ada/ * fe.h (Is_Atomic_Object): Declare. (Is_Volatile_Object): Likewise. * gcc-interface/trans.c (atomic_or_volatile_copy_required_p): New. (Call_to_gnu): Generate a copy for an actual parameter passed by reference if the conditions set forth by RM C.6(19) are met and specificially deal with an atomic actual parameter. gcc/testsuite/ * gnat.dg/atomic11.adb, gnat.dg/atomic11_pkg1.ads, gnat.dg/atomic11_pkg2.ads: New testcase. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@266993 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8e2f54c0c5fd..8c5d2a9b11e4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2018-12-11 Eric Botcazou + + * fe.h (Is_Atomic_Object): Declare. + (Is_Volatile_Object): Likewise. + * gcc-interface/trans.c (atomic_or_volatile_copy_required_p): + New. + (Call_to_gnu): Generate a copy for an actual parameter passed by + reference if the conditions set forth by RM C.6(19) are met and + specificially deal with an atomic actual parameter. + 2018-12-11 Piotr Trojanek * sem_util.adb (Is_Subprogram_Stub_Without_Prior_Declaration): diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index c85d69c5825e..cbd3ee255876 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -281,13 +281,17 @@ extern Boolean Is_OK_Static_Subtype (Entity_Id); #define Defining_Entity sem_util__defining_entity #define First_Actual sem_util__first_actual #define Next_Actual sem_util__next_actual +#define Is_Atomic_Object sem_util__is_atomic_object #define Is_Variable_Size_Record sem_util__is_variable_size_record +#define Is_Volatile_Object sem_util__is_volatile_object #define Requires_Transient_Scope sem_util__requires_transient_scope extern Entity_Id Defining_Entity (Node_Id); extern Node_Id First_Actual (Node_Id); extern Node_Id Next_Actual (Node_Id); +extern Boolean Is_Atomic_Object (Node_Id); extern Boolean Is_Variable_Size_Record (Entity_Id Id); +extern Boolean Is_Volatile_Object (Node_Id); extern Boolean Requires_Transient_Scope (Entity_Id); /* sinfo: */ diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 5caba9947297..c2553d83ec82 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -4936,6 +4936,35 @@ create_init_temporary (const char *prefix, tree gnu_init, tree *gnu_init_stmt, return gnu_temp; } +/* Return whether ACTUAL parameter corresponding to FORMAL_TYPE must be passed + by copy in a call as per RM C.6(19). Note that we use the same predicates + as in the front-end for RM C.6(12) because it's purely a legality issue. */ + +static bool +atomic_or_volatile_copy_required_p (Node_Id actual, Entity_Id formal_type) +{ + /* We should not have a scalar type here because such a type is passed + by copy. But the Interlocked routines in System.Aux_DEC force some + of the their scalar parameters to be passed by reference so we need + to preserve that if we do not want to break the interface. */ + if (Is_Scalar_Type (formal_type)) + return false; + + if (Is_Atomic_Object (actual) && !Is_Atomic (formal_type)) + { + post_error ("?atomic actual passed by copy (RM C.6(19))", actual); + return true; + } + + if (Is_Volatile_Object (actual) && !Is_Volatile (formal_type)) + { + post_error ("?volatile actual passed by copy (RM C.6(19))", actual); + return true; + } + + return false; +} + /* Subroutine of gnat_to_gnu to translate gnat_node, either an N_Function_Call or an N_Procedure_Call_Statement, to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to where we should place the result type. @@ -5150,13 +5179,18 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, = build_compound_expr (TREE_TYPE (gnu_name), init, gnu_name); } - /* If we are passing a non-addressable parameter by reference, pass the - address of a copy. In the In Out or Out case, set up to copy back - out after the call. */ + /* If we are passing a non-addressable actual parameter by reference, + pass the address of a copy and, in the In Out or Out case, set up + to copy back after the call. We also need to do that if the actual + parameter is atomic or volatile but the formal parameter is not. */ if (is_by_ref_formal_parm && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name))) - && !addressable_p (gnu_name, gnu_name_type)) + && (!addressable_p (gnu_name, gnu_name_type) + || (Comes_From_Source (gnat_node) + && atomic_or_volatile_copy_required_p (gnat_actual, + gnat_formal_type)))) { + const bool atomic_p = atomic_access_required_p (gnat_actual, &sync); tree gnu_orig = gnu_name, gnu_temp, gnu_stmt; /* Do not issue warnings for CONSTRUCTORs since this is not a copy @@ -5236,6 +5270,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, } /* Create an explicit temporary holding the copy. */ + if (atomic_p) + gnu_name = build_atomic_load (gnu_name, sync); gnu_temp = create_init_temporary ("A", gnu_name, &gnu_stmt, gnat_actual); @@ -5256,8 +5292,13 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, (TREE_OPERAND (TREE_OPERAND (gnu_orig, 1), 1))) gnu_orig = TREE_OPERAND (gnu_orig, 2); - gnu_stmt - = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig, gnu_temp); + if (atomic_p) + gnu_stmt + = build_atomic_store (gnu_orig, gnu_temp, sync); + else + gnu_stmt + = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig, + gnu_temp); set_expr_location_from_node (gnu_stmt, gnat_node); append_to_statement_list (gnu_stmt, &gnu_after_list); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index daae085b1a96..8591d318f56c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-12-11 Eric Botcazou + + * gnat.dg/atomic11.adb, gnat.dg/atomic11_pkg1.ads, + gnat.dg/atomic11_pkg2.ads: New testcase. + 2018-12-11 Ed Schonberg * gnat.dg/aspect1.adb, gnat.dg/aspect1_horizontal.adb, diff --git a/gcc/testsuite/gnat.dg/atomic11.adb b/gcc/testsuite/gnat.dg/atomic11.adb new file mode 100644 index 000000000000..18a3191e1cb2 --- /dev/null +++ b/gcc/testsuite/gnat.dg/atomic11.adb @@ -0,0 +1,19 @@ +-- { dg-do compile } + +with Atomic11_Pkg1; use Atomic11_Pkg1; + +procedure Atomic11 is + + R1 : Rec1; + pragma Atomic (R1); + + R2 : Rec2; + pragma Volatile (R2); + +begin + R1.I := 0; + Proc1 (R1); -- { dg-warning "atomic actual passed by copy" } + R2.A(1) := 0; + Proc1 (R1); -- { dg-warning "atomic actual passed by copy" } + Proc2 (R2); -- { dg-warning "volatile actual passed by copy" } +end; diff --git a/gcc/testsuite/gnat.dg/atomic11_pkg1.ads b/gcc/testsuite/gnat.dg/atomic11_pkg1.ads new file mode 100644 index 000000000000..574fd6329b5e --- /dev/null +++ b/gcc/testsuite/gnat.dg/atomic11_pkg1.ads @@ -0,0 +1,20 @@ +with Atomic11_Pkg2; + +package Atomic11_Pkg1 is + + type Rec1 is record + I : Integer; + end record; + + procedure Proc1 (R : Rec1); + pragma Import (C, Proc1); + + type Arr is array (Positive range <>) of Integer; + + type Rec2 is record + A : Arr (1 .. Atomic11_Pkg2.Max); + end record; + + procedure Proc2 (R : Rec2); + +end Atomic11_Pkg1; diff --git a/gcc/testsuite/gnat.dg/atomic11_pkg2.ads b/gcc/testsuite/gnat.dg/atomic11_pkg2.ads new file mode 100644 index 000000000000..681bcab8a653 --- /dev/null +++ b/gcc/testsuite/gnat.dg/atomic11_pkg2.ads @@ -0,0 +1,5 @@ +package Atomic11_Pkg2 is + + function Max return Positive; + +end Atomic11_Pkg2;