+2014-08-04 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Component>: Deal with
+ renaming discriminants in tagged types first.
+ * gcc-interface/trans.c (gnat_to_gnu) <N_Selected_Component>: Test
+ the underlying type of the prefix.
+ (Pragma_to_gnu, case Pragma_Warning): Ignore Reason => "..."
+ (process_freeze_entity): Reset the nodes of
+ all the view of a type, if any.
+
+2014-08-04 Doug Rupp <rupp@adacore.com>
+ Olivier Hainque <hainque@adacore.com>
+
+ * gcc-interface/Makefile.in (x86 VxWorks): Add filter-out for vxworks7
+ and remove incorrect EH_MECHANISM macros.
+ Add sigtramp.h to EXTRA_LIBGNAT_SRCS when we add sigtramp-vxworks.o to
+ EXTRA_LIBGNAT_OBJS.
+
2014-08-04 Robert Dewar <dewar@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): Make sure prefix
# Additionnal object files from C source to be added to libgnat.
EXTRA_LIBGNAT_OBJS=
-# Additionnal C source file to be added to libgnat without corresponding object
-# file (included files).
+
+# Additionnal C source files to be added to libgnat without corresponding
+# object file (#included files). This should include at least the GNAT
+# specific header files required to rebuild the runtime library from sources.
EXTRA_LIBGNAT_SRCS=
# GCC spec files to be installed in $(libsubdir), so --specs=<spec-filename>
EH_MECHANISM=-gcc
EXTRA_LIBGNAT_OBJS+=affinity.o sigtramp-vxworks.o
+ EXTRA_LIBGNAT_SRCS+=sigtramp.h
else
ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
endif
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
EXTRA_LIBGNAT_OBJS+=sigtramp-vxworks.o
+ EXTRA_LIBGNAT_SRCS+=sigtramp.h
endif
endif
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
EXTRA_LIBGNAT_OBJS+=sigtramp-vxworks.o
+ EXTRA_LIBGNAT_SRCS+=sigtramp.h
# Extra pairs for the vthreads runtime
ifeq ($(strip $(filter-out vthreads,$(THREAD_KIND))),)
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o sigtramp-vxworks.o
+ EXTRA_LIBGNAT_SRCS+=sigtramp.h
GNATRTL_SOCKETS_OBJS =
ifeq ($(strip $(filter-out yes,$(TRACE))),)
endif
# x86 VxWorks
-ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(target_os))),)
+ifeq ($(strip $(filter-out %86 wrs vxworks vxworks7,$(target_cpu) $(target_vendor) $(target_os))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-vxworks.ads \
i-vxwork.ads<i-vxwork-x86.ads \
EXTRA_LIBGNAT_OBJS+=affinity.o
else
ifeq ($(strip $(filter-out kernel-smp, $(THREAD_KIND))),)
- EH_MECHANISM=-gcc
-
LIBGNAT_TARGET_PAIRS += \
s-interr.adb<s-interr-hwint.adb \
s-mudido.adb<s-mudido-affinity.adb \
s-tpopsp.adb<s-tpopsp-vxworks.adb
ifeq ($(strip $(filter-out kernel,$(THREAD_KIND))),)
- EH_MECHANISM=-gcc
-
LIBGNAT_TARGET_PAIRS += \
s-vxwext.ads<s-vxwext-kernel.ads \
s-vxwext.adb<s-vxwext-kernel.adb \
system.ads<system-vxworks-arm-rtp.ads
EXTRA_LIBGNAT_OBJS+=affinity.o sigtramp-vxworks.o
+ EXTRA_LIBGNAT_SRCS+=sigtramp.h
else
ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
EH_MECHANISM=-gcc
system.ads<system-vxworks-arm.ads
EXTRA_LIBGNAT_OBJS+=affinity.o sigtramp-vxworks.o
+ EXTRA_LIBGNAT_SRCS+=sigtramp.h
else
LIBGNAT_TARGET_PAIRS += \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-vxwext.adb<s-vxwext-kernel.adb
EXTRA_LIBGNAT_OBJS+=sigtramp-vxworks.o
+ EXTRA_LIBGNAT_SRCS+=sigtramp.h
endif
endif
endif
/* The GNAT record where the component was defined. */
Entity_Id gnat_record = Underlying_Type (Scope (gnat_entity));
- /* If the entity is an inherited component (in the case of extended
- tagged record types), just return the original entity, which must
- be a FIELD_DECL. Likewise for discriminants. If the entity is a
- non-girder discriminant (in the case of derived untagged record
- types), return the stored discriminant it renames. */
- if (Present (Original_Record_Component (gnat_entity))
- && Original_Record_Component (gnat_entity) != gnat_entity)
+ /* If the entity is a discriminant of an extended tagged type used to
+ rename a discriminant of the parent type, return the latter. */
+ if (Is_Tagged_Type (gnat_record)
+ && Present (Corresponding_Discriminant (gnat_entity)))
{
gnu_decl
- = gnat_to_gnu_entity (Original_Record_Component (gnat_entity),
+ = gnat_to_gnu_entity (Corresponding_Discriminant (gnat_entity),
gnu_expr, definition);
saved = true;
break;
}
- /* If this is a discriminant of an extended tagged type used to rename
- a discriminant of the parent type, return the latter. */
- else if (Present (Corresponding_Discriminant (gnat_entity)))
+ /* If the entity is an inherited component (in the case of extended
+ tagged record types), just return the original entity, which must
+ be a FIELD_DECL. Likewise for discriminants. If the entity is a
+ non-girder discriminant (in the case of derived untagged record
+ types), return the stored discriminant it renames. */
+ else if (Present (Original_Record_Component (gnat_entity))
+ && Original_Record_Component (gnat_entity) != gnat_entity)
{
- /* If the derived type is untagged, then this is a non-girder
- discriminant and its Original_Record_Component must point to
- the stored discriminant it renames (i.e. we should have taken
- the previous branch). */
- gcc_assert (Is_Tagged_Type (gnat_record));
-
gnu_decl
- = gnat_to_gnu_entity (Corresponding_Discriminant (gnat_entity),
+ = gnat_to_gnu_entity (Original_Record_Component (gnat_entity),
gnu_expr, definition);
saved = true;
break;
for (index = ndim - 1; index >= 0; index--)
{
tem = build_nonshared_array_type (tem, gnu_index_types[index]);
- if (Reverse_Storage_Order (gnat_entity))
+ if (Reverse_Storage_Order (gnat_entity) && !GNAT_Mode)
sorry ("non-default Scalar_Storage_Order");
TYPE_MULTI_ARRAY_P (tem) = (index > 0);
if (array_type_has_nonaliased_component (tem, gnat_entity))
gnu_type = make_node (tree_code_for_record_type (gnat_entity));
TYPE_NAME (gnu_type) = gnu_entity_name;
TYPE_PACKED (gnu_type) = (packed != 0) || has_rep;
-
if (Reverse_Storage_Order (gnat_entity) && !GNAT_Mode)
sorry ("non-default Scalar_Storage_Order");
process_attributes (&gnu_type, &attr_list, true, gnat_entity);
gcc_unreachable ();
}
- if (Present (Next (gnat_temp)))
+ /* Deal with optional pattern (but ignore Reason => "..."). */
+ if (Present (Next (gnat_temp)) && No (Chars (Next (gnat_temp))))
{
/* pragma Warnings (On | Off, Name) is handled differently. */
if (Nkind (Expression (Next (gnat_temp))) != N_String_Literal)
/* For discriminant references in tagged types always substitute the
corresponding discriminant as the actual selected component. */
- if (Is_Tagged_Type (Etype (gnat_prefix)))
+ if (Is_Tagged_Type (Underlying_Type (Etype (gnat_prefix))))
while (Present (Corresponding_Discriminant (gnat_field)))
gnat_field = Corresponding_Discriminant (gnat_field);
{
Entity_Id full_view = Full_View (gnat_entity);
+ save_gnu_tree (full_view, NULL_TREE, false);
+
if (IN (Ekind (full_view), Private_Kind)
&& Present (Underlying_Full_View (full_view)))
- full_view = Underlying_Full_View (full_view);
-
- if (present_gnu_tree (full_view))
- save_gnu_tree (full_view, NULL_TREE, false);
+ {
+ full_view = Underlying_Full_View (full_view);
+ save_gnu_tree (full_view, NULL_TREE, false);
+ }
}
if (IN (kind, Type_Kind)