Commit 41683e1a by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): Put volatile qualifier on types at the very end of the processing.

	* gcc-interface/decl.c (gnat_to_gnu_entity): Put volatile qualifier
	on types at the very end of the processing.
	(gnat_to_gnu_param): Remove redundant test.
	(change_qualified_type): Do nothing for unconstrained array types.

From-SVN: r240915
parent 036a2fa2
2016-10-10 Eric Botcazou <ebotcazou@adacore.com> 2016-10-10 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Put volatile qualifier
on types at the very end of the processing.
(gnat_to_gnu_param): Remove redundant test.
(change_qualified_type): Do nothing for unconstrained array types.
2016-10-10 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils2.c (find_common_type): Do not return the LHS type * gcc-interface/utils2.c (find_common_type): Do not return the LHS type
if it's an array with non-constant lower bound and the RHS type is an if it's an array with non-constant lower bound and the RHS type is an
array with a constant one. array with a constant one.
......
...@@ -4728,14 +4728,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -4728,14 +4728,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
&& AGGREGATE_TYPE_P (gnu_type) && AGGREGATE_TYPE_P (gnu_type)
&& TYPE_BY_REFERENCE_P (gnu_type)) && TYPE_BY_REFERENCE_P (gnu_type))
SET_TYPE_MODE (gnu_type, BLKmode); SET_TYPE_MODE (gnu_type, BLKmode);
if (Treat_As_Volatile (gnat_entity))
{
const int quals
= TYPE_QUAL_VOLATILE
| (Is_Atomic_Or_VFA (gnat_entity) ? TYPE_QUAL_ATOMIC : 0);
gnu_type = change_qualified_type (gnu_type, quals);
}
} }
/* If this is a derived type, relate its alias set to that of its parent /* If this is a derived type, relate its alias set to that of its parent
...@@ -4816,6 +4808,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -4816,6 +4808,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
? ALIAS_SET_COPY : ALIAS_SET_SUPERSET); ? ALIAS_SET_COPY : ALIAS_SET_SUPERSET);
} }
if (Treat_As_Volatile (gnat_entity))
{
const int quals
= TYPE_QUAL_VOLATILE
| (Is_Atomic_Or_VFA (gnat_entity) ? TYPE_QUAL_ATOMIC : 0);
gnu_type = change_qualified_type (gnu_type, quals);
}
if (!gnu_decl) if (!gnu_decl)
gnu_decl = create_type_decl (gnu_entity_name, gnu_type, gnu_decl = create_type_decl (gnu_entity_name, gnu_type,
artificial_p, debug_info_p, artificial_p, debug_info_p,
...@@ -5386,12 +5386,9 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, ...@@ -5386,12 +5386,9 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first,
} }
/* If this is a read-only parameter, make a variant of the type that is /* If this is a read-only parameter, make a variant of the type that is
read-only. ??? However, if this is an unconstrained array, that type read-only. ??? However, if this is a self-referential type, the type
can be very complex, so skip it for now. Likewise for any other can be very complex, so skip it for now. */
self-referential type. */ if (ro_param && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_param_type)))
if (ro_param
&& TREE_CODE (gnu_param_type) != UNCONSTRAINED_ARRAY_TYPE
&& !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_param_type)))
gnu_param_type = change_qualified_type (gnu_param_type, TYPE_QUAL_CONST); gnu_param_type = change_qualified_type (gnu_param_type, TYPE_QUAL_CONST);
/* For foreign conventions, pass arrays as pointers to the element type. /* For foreign conventions, pass arrays as pointers to the element type.
...@@ -6254,6 +6251,10 @@ gnu_ext_name_for_subprog (Entity_Id gnat_subprog, tree gnu_entity_name) ...@@ -6254,6 +6251,10 @@ gnu_ext_name_for_subprog (Entity_Id gnat_subprog, tree gnu_entity_name)
static tree static tree
change_qualified_type (tree type, int type_quals) change_qualified_type (tree type, int type_quals)
{ {
/* Qualifiers must be put on the associated array type. */
if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
return type;
return build_qualified_type (type, TYPE_QUALS (type) | type_quals); return build_qualified_type (type, TYPE_QUALS (type) | type_quals);
} }
......
2016-10-10 Eric Botcazou <ebotcazou@adacore.com> 2016-10-10 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/vfa.ads: New test.
2016-10-10 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/inline13.ad[sb]: New test. * gnat.dg/inline13.ad[sb]: New test.
* gnat.dg/inline13_pkg.ad[sb]: New helper. * gnat.dg/inline13_pkg.ad[sb]: New helper.
......
-- { dg-do compile }
-- { dg-options "-g" }
package VFA is
type Rec is record
A : Short_Integer;
B : Short_Integer;
end record;
type Rec_VFA is new Rec;
pragma Volatile_Full_Access (Rec_VFA);
end VFA;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment