===================================================================
@@ -6,7 +6,7 @@
* *
* C Header File *
* *
- * Copyright (C) 1992-2016, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2017, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -219,6 +219,7 @@
extern void Check_Implicit_Dynamic_Code_Allowed (Node_Id);
/* sem_aggr: */
+
#define Is_Others_Aggregate sem_aggr__is_others_aggregate
extern Boolean Is_Others_Aggregate (Node_Id);
@@ -297,6 +298,12 @@
extern Boolean Stack_Check_Probes_On_Target;
extern Boolean Stack_Check_Limits_On_Target;
+/* warnsw: */
+
+#define Warn_On_Questionable_Layout warnsw__warn_on_questionable_layout
+
+extern Boolean Warn_On_Questionable_Layout;
+
#ifdef __cplusplus
}
#endif
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1999-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -75,6 +75,7 @@
Warn_On_Overlap := Setting;
Warn_On_Overridden_Size := Setting;
Warn_On_Parameter_Order := Setting;
+ Warn_On_Questionable_Layout := Setting;
Warn_On_Questionable_Missing_Parens := Setting;
Warn_On_Record_Holes := Setting;
Warn_On_Redundant_Constructs := Setting;
@@ -166,6 +167,8 @@
W.Warn_On_Overridden_Size;
Warn_On_Parameter_Order :=
W.Warn_On_Parameter_Order;
+ Warn_On_Questionable_Layout :=
+ W.Warn_On_Questionable_Layout;
Warn_On_Questionable_Missing_Parens :=
W.Warn_On_Questionable_Missing_Parens;
Warn_On_Record_Holes :=
@@ -270,6 +273,8 @@
Warn_On_Overridden_Size;
W.Warn_On_Parameter_Order :=
Warn_On_Parameter_Order;
+ W.Warn_On_Questionable_Layout :=
+ Warn_On_Questionable_Layout;
W.Warn_On_Questionable_Missing_Parens :=
Warn_On_Questionable_Missing_Parens;
W.Warn_On_Record_Holes :=
@@ -394,6 +399,12 @@
when 'P' =>
Warn_On_Parameter_Order := False;
+ when 'q' =>
+ Warn_On_Questionable_Layout := True;
+
+ when 'Q' =>
+ Warn_On_Questionable_Layout := False;
+
when 'r' =>
Warn_On_Object_Renames_Function := True;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1999-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -42,16 +42,21 @@
-- Warn when tagged type public primitives are defined after its private
-- extensions.
- Warn_On_Record_Holes : Boolean := False;
- -- Warn when explicit record component clauses leave uncovered holes (gaps)
- -- in a record layout. Off by default, set by -gnatw.h (but not -gnatwa).
-
Warn_On_Overridden_Size : Boolean := False;
-- Warn when explicit record component clause or array component_size
-- clause specifies a size that overrides a size for the type which was
-- set with an explicit size clause. Off by default, modified by use of
-- -gnatw.s/.S (but not -gnatwa).
+ Warn_On_Questionable_Layout : Boolean := False;
+ -- Warn when default layout of a record type is questionable for run-time
+ -- efficiency reasons and would be improved by reordering the components.
+ -- Off by default, modified by use of -gnatw.q/.Q (but not -gnatwa).
+
+ Warn_On_Record_Holes : Boolean := False;
+ -- Warn when explicit record component clauses leave uncovered holes (gaps)
+ -- in a record layout. Off by default, set by -gnatw.h (but not -gnatwa).
+
Warn_On_Size_Alignment : Boolean := True;
-- Warn when explicit Size and Alignment clauses are given for a type, and
-- the size is not a multiple of the alignment. Off by default, modified
@@ -104,6 +109,7 @@
Warn_On_Overlap : Boolean;
Warn_On_Overridden_Size : Boolean;
Warn_On_Parameter_Order : Boolean;
+ Warn_On_Questionable_Layout : Boolean;
Warn_On_Questionable_Missing_Parens : Boolean;
Warn_On_Record_Holes : Boolean;
Warn_On_Redundant_Constructs : Boolean;
===================================================================
@@ -217,8 +217,9 @@
static bool allocatable_size_p (tree, bool);
static bool initial_value_needs_conversion (tree, tree);
static int compare_field_bitpos (const PTR, const PTR);
-static bool components_to_record (tree, Node_Id, tree, int, bool, bool, bool,
- bool, bool, bool, bool, bool, tree, tree *);
+static bool components_to_record (Node_Id, Entity_Id, tree, tree, int, bool,
+ bool, bool, bool, bool, bool, bool, tree,
+ tree *);
static Uint annotate_value (tree);
static void annotate_rep (Entity_Id, tree);
static tree build_position_list (tree, bool, tree, tree, unsigned int, tree);
@@ -3328,11 +3329,10 @@
}
/* Add the fields into the record type and finish it up. */
- components_to_record (gnu_type, Component_List (record_definition),
- gnu_field_list, packed, definition, false,
- all_rep, is_unchecked_union,
- artificial_p, debug_info_p,
- false, OK_To_Reorder_Components (gnat_entity),
+ components_to_record (Component_List (record_definition), gnat_entity,
+ gnu_field_list, gnu_type, packed, definition,
+ false, all_rep, is_unchecked_union, artificial_p,
+ debug_info_p, false,
all_rep ? NULL_TREE : bitsize_zero_node, NULL);
/* Fill in locations of fields. */
@@ -7463,6 +7463,71 @@
return ret ? ret : (int) (DECL_UID (field1) - DECL_UID (field2));
}
+/* Reverse function from gnat_to_gnu_field: return the GNAT field present in
+ either GNAT_COMPONENT_LIST or the discriminants of GNAT_RECORD_TYPE, and
+ corresponding to the GNU tree GNU_FIELD. */
+
+static Entity_Id
+gnu_field_to_gnat (tree gnu_field, Node_Id gnat_component_list,
+ Entity_Id gnat_record_type)
+{
+ Entity_Id gnat_component_decl, gnat_field;
+
+ if (Present (Component_Items (gnat_component_list)))
+ for (gnat_component_decl
+ = First_Non_Pragma (Component_Items (gnat_component_list));
+ Present (gnat_component_decl);
+ gnat_component_decl = Next_Non_Pragma (gnat_component_decl))
+ {
+ gnat_field = Defining_Entity (gnat_component_decl);
+ if (gnat_to_gnu_field_decl (gnat_field) == gnu_field)
+ return gnat_field;
+ }
+
+ if (Has_Discriminants (gnat_record_type))
+ for (gnat_field = First_Stored_Discriminant (gnat_record_type);
+ Present (gnat_field);
+ gnat_field = Next_Stored_Discriminant (gnat_field))
+ if (gnat_to_gnu_field_decl (gnat_field) == gnu_field)
+ return gnat_field;
+
+ return Empty;
+}
+
+/* Issue a warning for the problematic placement of GNU_FIELD present in
+ either GNAT_COMPONENT_LIST or the discriminants of GNAT_RECORD_TYPE.
+ IN_VARIANT is true if GNAT_COMPONENT_LIST is the list of a variant.
+ DO_REORDER is true if fields of GNAT_RECORD_TYPE are being reordered. */
+
+static void
+warn_on_field_placement (tree gnu_field, Node_Id gnat_component_list,
+ Entity_Id gnat_record_type, bool in_variant,
+ bool do_reorder)
+{
+ const char *msg1
+ = in_variant
+ ? "?variant layout may cause performance issues"
+ : "?record layout may cause performance issues";
+ const char *msg2
+ = field_has_self_size (gnu_field)
+ ? "?component & whose length depends on a discriminant"
+ : field_has_variable_size (gnu_field)
+ ? "?component & whose length is not fixed"
+ : "?component & whose length is not multiple of a byte";
+ const char *msg3
+ = do_reorder
+ ? "?comes too early and was moved down"
+ : "?comes too early and ought to be moved down";
+ Entity_Id gnat_field
+ = gnu_field_to_gnat (gnu_field, gnat_component_list, gnat_record_type);
+
+ gcc_assert (Present (gnat_field));
+
+ post_error (msg1, gnat_field);
+ post_error_ne (msg2, gnat_field, gnat_field);
+ post_error (msg3, gnat_field);
+}
+
/* Structure holding information for a given variant. */
typedef struct vinfo
{
@@ -7483,14 +7548,15 @@
} vinfo_t;
-/* Translate and chain the GNAT_COMPONENT_LIST to the GNU_FIELD_LIST, set the
- result as the field list of GNU_RECORD_TYPE and finish it up. Return true
- if GNU_RECORD_TYPE has a rep clause which affects the layout (see below).
- When called from gnat_to_gnu_entity during the processing of a record type
- definition, the GCC node for the parent, if any, will be the single field
- of GNU_RECORD_TYPE and the GCC nodes for the discriminants will be on the
- GNU_FIELD_LIST. The other calls to this function are recursive calls for
- the component list of a variant and, in this case, GNU_FIELD_LIST is empty.
+/* Translate and chain GNAT_COMPONENT_LIST present in GNAT_RECORD_TYPE to
+ GNU_FIELD_LIST, set the result as the field list of GNU_RECORD_TYPE and
+ finish it up. Return true if GNU_RECORD_TYPE has a rep clause that affects
+ the layout (see below). When called from gnat_to_gnu_entity during the
+ processing of a record definition, the GCC node for the parent, if any,
+ will be the single field of GNU_RECORD_TYPE and the GCC nodes for the
+ discriminants will be on GNU_FIELD_LIST. The other call to this function
+ is a recursive call for the component list of a variant and, in this case,
+ GNU_FIELD_LIST is empty.
PACKED is 1 if this is for a packed record or -1 if this is for a record
with Component_Alignment of Storage_Unit.
@@ -7514,8 +7580,6 @@
MAYBE_UNUSED is true if this type may be unused in the end; this doesn't
mean that its contents may be unused as well, only the container itself.
- REORDER is true if we are permitted to reorder components of this type.
-
FIRST_FREE_POS, if nonzero, is the first (lowest) free field position in
the outer record type down to this variant level. It is nonzero only if
all the fields down to this level have a rep clause and ALL_REP is false.
@@ -7525,12 +7589,12 @@
be done with such fields and the return value will be false. */
static bool
-components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
- tree gnu_field_list, int packed, bool definition,
- bool cancel_alignment, bool all_rep,
- bool unchecked_union, bool artificial,
- bool debug_info, bool maybe_unused, bool reorder,
- tree first_free_pos, tree *p_gnu_rep_list)
+components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type,
+ tree gnu_field_list, tree gnu_record_type, int packed,
+ bool definition, bool cancel_alignment, bool all_rep,
+ bool unchecked_union, bool artificial, bool debug_info,
+ bool maybe_unused, tree first_free_pos,
+ tree *p_gnu_rep_list)
{
const bool needs_xv_encodings
= debug_info && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL;
@@ -7539,24 +7603,21 @@
bool layout_with_rep = false;
bool has_self_field = false;
bool has_aliased_after_self_field = false;
- Node_Id component_decl, variant_part;
+ Entity_Id gnat_component_decl, gnat_variant_part;
tree gnu_field, gnu_next, gnu_last;
tree gnu_variant_part = NULL_TREE;
tree gnu_rep_list = NULL_TREE;
- tree gnu_var_list = NULL_TREE;
- tree gnu_self_list = NULL_TREE;
- tree gnu_zero_list = NULL_TREE;
/* For each component referenced in a component declaration create a GCC
field and add it to the list, skipping pragmas in the GNAT list. */
gnu_last = tree_last (gnu_field_list);
if (Present (Component_Items (gnat_component_list)))
- for (component_decl
+ for (gnat_component_decl
= First_Non_Pragma (Component_Items (gnat_component_list));
- Present (component_decl);
- component_decl = Next_Non_Pragma (component_decl))
+ Present (gnat_component_decl);
+ gnat_component_decl = Next_Non_Pragma (gnat_component_decl))
{
- Entity_Id gnat_field = Defining_Entity (component_decl);
+ Entity_Id gnat_field = Defining_Entity (gnat_component_decl);
Name_Id gnat_name = Chars (gnat_field);
/* If present, the _Parent field must have been created as the single
@@ -7603,7 +7664,7 @@
}
/* At the end of the component list there may be a variant part. */
- variant_part = Variant_Part (gnat_component_list);
+ gnat_variant_part = Variant_Part (gnat_component_list);
/* We create a QUAL_UNION_TYPE for the variant part since the variants are
mutually exclusive and should go in the same memory. To do this we need
@@ -7612,9 +7673,9 @@
lists for the variants and put them all into the QUAL_UNION_TYPE.
If this is an Unchecked_Union, we make a UNION_TYPE instead or
use GNU_RECORD_TYPE if there are no fields so far. */
- if (Present (variant_part))
+ if (Present (gnat_variant_part))
{
- Node_Id gnat_discr = Name (variant_part), variant;
+ Node_Id gnat_discr = Name (gnat_variant_part), variant;
tree gnu_discr = gnat_to_gnu (gnat_discr);
tree gnu_name = TYPE_IDENTIFIER (gnu_record_type);
tree gnu_var_name
@@ -7676,7 +7737,7 @@
the container types and computing the associated properties. However
we cannot finish up the container types during this pass because we
don't know where the variant part will be placed until the end. */
- for (variant = First_Non_Pragma (Variants (variant_part));
+ for (variant = First_Non_Pragma (Variants (gnat_variant_part));
Present (variant);
variant = Next_Non_Pragma (variant))
{
@@ -7712,12 +7773,11 @@
/* Add the fields into the record type for the variant. Note that
we aren't sure to really use it at this point, see below. */
has_rep
- = components_to_record (gnu_variant_type, Component_List (variant),
- NULL_TREE, packed, definition,
- !all_rep_and_size, all_rep,
- unchecked_union,
- true, needs_xv_encodings, true, reorder,
- this_first_free_pos,
+ = components_to_record (Component_List (variant), gnat_record_type,
+ NULL_TREE, gnu_variant_type, packed,
+ definition, !all_rep_and_size, all_rep,
+ unchecked_union, true, needs_xv_encodings,
+ true, this_first_free_pos,
all_rep || this_first_free_pos
? NULL : &gnu_rep_list);
@@ -7873,19 +7933,44 @@
}
}
- /* Scan GNU_FIELD_LIST and see if any fields have rep clauses and, if we are
- permitted to reorder components, self-referential sizes or variable sizes.
- If they do, pull them out and put them onto the appropriate list. We have
- to do this in a separate pass since we want to handle the discriminants
- but can't play with them until we've used them in debugging data above.
+ /* Scan GNU_FIELD_LIST and see if any fields have rep clauses. If they do,
+ pull them out and put them onto the appropriate list. We have to do it
+ in a separate pass since we want to handle the discriminants but can't
+ play with them until we've used them in debugging data above.
Similarly, pull out the fields with zero size and no rep clause, as they
would otherwise modify the layout and thus very likely run afoul of the
Ada semantics, which are different from those of C here.
+ Finally, if there is an aliased field placed in the list after fields
+ with self-referential size, pull out the latter in the same way.
+
+ Optionally, if the reordering mechanism is enabled, pull out the fields
+ with self-referential size, variable size and fixed size not a multiple
+ of a byte, so that they don't cause the regular fields to be either at
+ self-referential/variable offset or misaligned. Note, in the latter
+ case, that this can only happen in packed record types so the alignment
+ is effectively capped to the byte for the whole record.
+
+ Optionally, if the layout warning is enabled, keep track of the above 4
+ different kinds of fields and issue a warning if some of them would be
+ (or are being) reordered by the reordering mechanism.
+
??? If we reorder them, debugging information will be wrong but there is
nothing that can be done about this at the moment. */
- gnu_last = NULL_TREE;
+ const bool do_reorder = OK_To_Reorder_Components (gnat_record_type);
+ const bool w_reorder
+ = Warn_On_Questionable_Layout
+ && (Convention (gnat_record_type) == Convention_Ada);
+ const bool in_variant = (p_gnu_rep_list != NULL);
+ tree gnu_zero_list = NULL_TREE;
+ tree gnu_self_list = NULL_TREE;
+ tree gnu_var_list = NULL_TREE;
+ tree gnu_bitp_list = NULL_TREE;
+ tree gnu_tmp_bitp_list = NULL_TREE;
+ unsigned int tmp_bitp_size = 0;
+ unsigned int last_reorder_field_type = -1;
+ unsigned int tmp_last_reorder_field_type = -1;
#define MOVE_FROM_FIELD_LIST_TO(LIST) \
do { \
@@ -7898,6 +7983,7 @@
(LIST) = gnu_field; \
} while (0)
+ gnu_last = NULL_TREE;
for (gnu_field = gnu_field_list; gnu_field; gnu_field = gnu_next)
{
gnu_next = DECL_CHAIN (gnu_field);
@@ -7908,19 +7994,6 @@
continue;
}
- if ((reorder || has_aliased_after_self_field)
- && field_has_self_size (gnu_field))
- {
- MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
- continue;
- }
-
- if (reorder && field_has_variable_size (gnu_field))
- {
- MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
- continue;
- }
-
if (DECL_SIZE (gnu_field) && integer_zerop (DECL_SIZE (gnu_field)))
{
DECL_FIELD_OFFSET (gnu_field) = size_zero_node;
@@ -7934,6 +8007,129 @@
continue;
}
+ if (has_aliased_after_self_field && field_has_self_size (gnu_field))
+ {
+ MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
+ continue;
+ }
+
+ /* We don't need further processing in default mode. */
+ if (!w_reorder && !do_reorder)
+ {
+ gnu_last = gnu_field;
+ continue;
+ }
+
+ if (field_has_self_size (gnu_field))
+ {
+ if (w_reorder)
+ {
+ if (last_reorder_field_type < 4)
+ warn_on_field_placement (gnu_field, gnat_component_list,
+ gnat_record_type, in_variant,
+ do_reorder);
+ else
+ last_reorder_field_type = 4;
+ }
+
+ if (do_reorder)
+ {
+ MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
+ continue;
+ }
+ }
+
+ else if (field_has_variable_size (gnu_field))
+ {
+ if (w_reorder)
+ {
+ if (last_reorder_field_type < 3)
+ warn_on_field_placement (gnu_field, gnat_component_list,
+ gnat_record_type, in_variant,
+ do_reorder);
+ else
+ last_reorder_field_type = 3;
+ }
+
+ if (do_reorder)
+ {
+ MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
+ continue;
+ }
+ }
+
+ else
+ {
+ /* If the field has no size, then it cannot be bit-packed. */
+ const unsigned int bitp_size
+ = DECL_SIZE (gnu_field)
+ ? TREE_INT_CST_LOW (DECL_SIZE (gnu_field)) % BITS_PER_UNIT
+ : 0;
+
+ /* If the field is bit-packed, we move it to a temporary list that
+ contains the contiguously preceding bit-packed fields, because
+ we want to be able to put them back if the misalignment happens
+ to cancel itself after several bit-packed fields. */
+ if (bitp_size != 0)
+ {
+ tmp_bitp_size = (tmp_bitp_size + bitp_size) % BITS_PER_UNIT;
+
+ if (last_reorder_field_type != 2)
+ {
+ tmp_last_reorder_field_type = last_reorder_field_type;
+ last_reorder_field_type = 2;
+ }
+
+ if (do_reorder)
+ {
+ MOVE_FROM_FIELD_LIST_TO (gnu_tmp_bitp_list);
+ continue;
+ }
+ }
+
+ /* No more bit-packed fields, move the existing ones to the end or
+ put them back at their original location. */
+ else if (last_reorder_field_type == 2 || gnu_tmp_bitp_list)
+ {
+ last_reorder_field_type = 1;
+
+ if (tmp_bitp_size != 0)
+ {
+ if (w_reorder && tmp_last_reorder_field_type < 2)
+ warn_on_field_placement (gnu_tmp_bitp_list
+ ? gnu_tmp_bitp_list : gnu_last,
+ gnat_component_list,
+ gnat_record_type, in_variant,
+ do_reorder);
+
+ if (do_reorder)
+ gnu_bitp_list = chainon (gnu_tmp_bitp_list, gnu_bitp_list);
+
+ gnu_tmp_bitp_list = NULL_TREE;
+ tmp_bitp_size = 0;
+ }
+ else
+ {
+ /* Rechain the temporary list in front of GNU_FIELD. */
+ tree gnu_bitp_field = gnu_field;
+ while (gnu_tmp_bitp_list)
+ {
+ tree gnu_bitp_next = DECL_CHAIN (gnu_tmp_bitp_list);
+ DECL_CHAIN (gnu_tmp_bitp_list) = gnu_bitp_field;
+ if (gnu_last)
+ DECL_CHAIN (gnu_last) = gnu_tmp_bitp_list;
+ else
+ gnu_field_list = gnu_tmp_bitp_list;
+ gnu_bitp_field = gnu_tmp_bitp_list;
+ gnu_tmp_bitp_list = gnu_bitp_next;
+ }
+ }
+ }
+
+ else
+ last_reorder_field_type = 1;
+ }
+
gnu_last = gnu_field;
}
@@ -7943,16 +8139,31 @@
/* If permitted, we reorder the fields as follows:
- 1) all fixed length fields,
- 2) all fields whose length doesn't depend on discriminants,
- 3) all fields whose length depends on discriminants,
- 4) the variant part,
+ 1) all (groups of) fields whose length is fixed and multiple of a byte,
+ 2) the remaining fields whose length is fixed and not multiple of a byte,
+ 3) the remaining fields whose length doesn't depend on discriminants,
+ 4) all fields whose length depends on discriminants,
+ 5) the variant part,
within the record and within each variant recursively. */
- if (reorder)
- gnu_field_list
- = chainon (gnu_field_list, chainon (gnu_var_list, gnu_self_list));
+ if (w_reorder
+ && last_reorder_field_type == 2
+ && tmp_last_reorder_field_type < 2)
+ warn_on_field_placement (gnu_tmp_bitp_list
+ ? gnu_tmp_bitp_list : gnu_field_list,
+ gnat_component_list, gnat_record_type,
+ in_variant, do_reorder);
+ if (do_reorder)
+ {
+ if (gnu_tmp_bitp_list)
+ gnu_bitp_list = chainon (gnu_tmp_bitp_list, gnu_bitp_list);
+ gnu_field_list
+ = chainon (gnu_field_list,
+ chainon (gnu_bitp_list,
+ chainon (gnu_var_list, gnu_self_list)));
+ }
+
/* Otherwise, if there is an aliased field placed after a field whose length
depends on discriminants, we put all the fields of the latter sort, last.
We need to do this in case an object of this record type is mutable. */
This implements a warning on the questionable placement of specific sorts of components in record types, more specifically those with non-fixed size or those with a fixed size that is not a mutiple of the storage unit. It is enabled by -gnatw.q (and disabled by -gnatw.Q) only for the time being. The placement of these fields can be problematic if they are followed in textual order by regular fields and there is no representation clause for them, because accesses to the latter fields may be most costly, both in terms of code size and performance at run time. Here's an example on a package compiled with -gnatw.q -gnatl: 1. with Q; use Q; 2. 3. package P is 4. 5. -- All fixed length => No reordering 6. type R1 is record 7. S1 : Short_Integer; 8. I1 : Integer; 9. S2 : Short_Integer; 10. end record; 11. 12. -- A1 variable length => Moved to the end 13. type R2 is record 14. A1 : Arr (1 .. Q.N); | >>> warning: record layout may cause performance issues >>> warning: component "A1" whose length is not fixed >>> warning: comes too early and ought to be moved down 15. I1 : Integer; 16. S1 : Short_Integer; 17. end record; 18. 19. -- A1 self-referential length => Moved to the end 20. type R3 (D : My_Index) is record 21. A1 : Arr (1 .. D); | >>> warning: record layout may cause performance issues >>> warning: component "A1" whose length depends on a discriminant >>> warning: comes too early and ought to be moved down 22. I1 : Integer; 23. S1 : Short_Integer; 24. end record; 25. 26. -- A1 self-referential length => Moved to the end 27. -- A2 variable length => Moved to right before A1 28. type R4 (D : My_Index) is record 29. A1 : Arr (1 .. D); | >>> warning: record layout may cause performance issues >>> warning: component "A1" whose length depends on a discriminant >>> warning: comes too early and ought to be moved down 30. A2 : Arr (1 .. Q.N); | >>> warning: record layout may cause performance issues >>> warning: component "A2" whose length is not fixed >>> warning: comes too early and ought to be moved down 31. I1 : Integer; 32. S1 : Short_Integer; 33. end record; 34. 35. -- A1 variable length => Moved to right before the variant part 36. type R5 (D : My_Index) is record 37. A1 : Arr (1 .. Q.N); | >>> warning: record layout may cause performance issues >>> warning: component "A1" whose length is not fixed >>> warning: comes too early and ought to be moved down 38. I1 : Integer; 39. S1 : Short_Integer; 40. case D is 41. when 1 => 42. I2 : Integer; 43. when others => 44. S2 : Short_Integer; 45. end case; 46. end record; 47. 48. -- A1 variable length => Moved to the end of the variant 49. -- A2 self-referential length => Moved to the end of the variant 50. type R6 (D : My_Index) is record 51. S1 : Short_Integer; 52. case D is 53. when 1 => 54. A1 : Arr (1 .. Q.N); | >>> warning: variant layout may cause performance issues >>> warning: component "A1" whose length is not fixed >>> warning: comes too early and ought to be moved down 55. I1 : Integer; 56. when others => 57. A2 : Arr (1 .. D); | >>> warning: variant layout may cause performance issues >>> warning: component "A2" whose length depends on a discriminant >>> warning: comes too early and ought to be moved down 58. S2 : Short_Integer; 59. end case; 60. end record; 61. 62. end P; 62 lines: No errors, 21 warnings Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-27 Eric Botcazou <ebotcazou@adacore.com> * fe.h (Warn_On_Questionable_Layout): Declare. * warnsw.ads (Warn_On_Record_Holes): Move down. (Warn_On_Questionable_Layout): New boolean variable. (Warning_Record): Add Warn_On_Questionable_Layout field. * warnsw.adb (All_Warnings): Set Warn_On_Questionable_Layout. (Restore_Warnings): Likewise. (Save_Warnings): Likewise. (Set_Dot_Warning_Switch): Handle 'q' and 'Q' letters. * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust call to components_to_record. (gnu_field_to_gnat): New function. (warn_on_field_placement): Likewise. (components_to_record): Add GNAT_RECORD_TYPE and remove REORDER parameters. Rename local variables and adjust recursive call. Rework final scan of the field list and implement warnings on the problematic placement of specific sorts of fields.