summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/5itaprop.adb15
-rw-r--r--gcc/ada/5vml-tgt.adb19
-rw-r--r--gcc/ada/ChangeLog69
-rw-r--r--gcc/ada/Makefile.adalib122
-rw-r--r--gcc/ada/Makefile.in12
-rw-r--r--gcc/ada/decl.c75
-rw-r--r--gcc/ada/exp_aggr.adb4
-rw-r--r--gcc/ada/exp_ch9.adb13
-rw-r--r--gcc/ada/exp_pakd.adb6
-rw-r--r--gcc/ada/make.adb173
-rw-r--r--gcc/ada/prj-part.adb30
-rw-r--r--gcc/ada/prj-proc.adb101
-rw-r--r--gcc/ada/prj-tree.adb8
-rw-r--r--gcc/ada/prj-tree.ads9
-rw-r--r--gcc/ada/sem_ch13.adb23
15 files changed, 388 insertions, 291 deletions
diff --git a/gcc/ada/5itaprop.adb b/gcc/ada/5itaprop.adb
index 54a6b488939..b967c18a950 100644
--- a/gcc/ada/5itaprop.adb
+++ b/gcc/ada/5itaprop.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -712,6 +712,7 @@ package body System.Task_Primitives.Operations is
(T.Common.LL.Thread, SCHED_FIFO, Param'Access);
else
+ Param.sched_priority := 0;
Result := pthread_setschedparam
(T.Common.LL.Thread, SCHED_OTHER, Param'Access);
end if;
@@ -1038,12 +1039,6 @@ package body System.Task_Primitives.Operations is
begin
Environment_Task_ID := Environment_Task;
- Result := pthread_mutexattr_init (Mutex_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
-
- Result := pthread_condattr_init (Cond_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
-
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
-- Initialize the global RTS lock
@@ -1096,5 +1091,11 @@ begin
pragma Assert (Result = 0);
end if;
end loop;
+
+ Result := pthread_mutexattr_init (Mutex_Attr'Access);
+ pragma Assert (Result = 0);
+
+ Result := pthread_condattr_init (Cond_Attr'Access);
+ pragma Assert (Result = 0);
end;
end System.Task_Primitives.Operations;
diff --git a/gcc/ada/5vml-tgt.adb b/gcc/ada/5vml-tgt.adb
index ecc39114e1c..835443723f9 100644
--- a/gcc/ada/5vml-tgt.adb
+++ b/gcc/ada/5vml-tgt.adb
@@ -69,6 +69,14 @@ package body MLib.Tgt is
Success : Boolean := False;
+ Shared_Libgcc : aliased String := "-shared-libgcc";
+
+ No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
+ Shared_Libgcc_Switch : aliased Argument_List :=
+ (1 => Shared_Libgcc'Access);
+ Link_With_Shared_Libgcc : Argument_List_Access :=
+ No_Shared_Libgcc_Switch'Access;
+
------------------------------
-- Target dependent section --
------------------------------
@@ -242,6 +250,14 @@ package body MLib.Tgt is
-- Start of processing for Build_Dynamic_Library
begin
+ -- Invoke gcc with -shared-libgcc, but only for GCC 3 or higher
+
+ if GCC_Version >= 3 then
+ Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
+ else
+ Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
+ end if;
+
VMS_Options (VMS_Options'First + 1) := For_Linker_Opt;
for J in Inter'Range loop
@@ -451,7 +467,8 @@ package body MLib.Tgt is
(Output_File => Lib_File,
Objects => Ofiles & Additional_Objects.all,
Options => VMS_Options,
- Options_2 => Opts (Opts'First .. Last_Opt) &
+ Options_2 => Link_With_Shared_Libgcc.all &
+ Opts (Opts'First .. Last_Opt) &
Opts2 (Opts2'First .. Last_Opt2),
Driver_Name => Driver_Name);
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 23ccd1eb269..d811dfcf25d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,72 @@
+2004-01-23 Robert Dewar <dewar@gnat.com>
+
+ * exp_aggr.adb: Minor reformatting
+
+ * exp_ch9.adb: Minor code clean up
+ Minor reformatting
+ Fix bad character in comment
+
+ PR ada/13471
+ * targparm.adb (Get_Target_Parameters): Give clean abort error on
+ unexpected end of file, along with more detailed message.
+
+2004-01-23 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
+
+ * exp_pakd.adb (Install_PAT): Clear Freeze_Node for PAT and Etype of
+ PAT.
+
+ * decl.c (copy_alias_set): New function.
+ (gnat_to_gnu_entity, make_aligning_type, make_packable_type): Use it.
+
+2004-01-23 Doug Rupp <rupp@gnat.com>
+
+ * Makefile.in (install-gnatlib): Change occurrences of lib$$file to
+ lib$${file} in case subsequent character is not a separator.
+
+2004-01-23 Vincent Celier <celier@gnat.com>
+
+ * 5vml-tgt.adb (Build_Dynamic_Library): Invoke gcc with -shared-libgcc
+ when the GCC version is at least 3.
+
+ * make.adb: (Scan_Make_Arg): Pass -B to Scan_Make_Switches
+ Remove all "Opt.", to prepare for opt split
+
+ * prj-part.adb (Parse_Single_Project): New Boolean out parameter
+ Extends_All. Set to True when the project parsed is an extending all
+ project. Fails for importing an extending all project only when the
+ imported project is an extending all project.
+ (Post_Parse_Context_Clause): Set Is_Extending_All to the with clause,
+ depending on the value of Extends_All returned.
+
+ * prj-proc.adb (Process): Check that no project shares its object
+ directory with a project that extends it, directly or indirectly,
+ including a virtual project.
+ Check that no project extended by another project shares its object
+ directory with another also extended project.
+
+ * prj-tree.adb (Is_Extending_All, Set_Is_Extending_All): Allow for
+ Kind = N_With_Clause
+
+ * prj-tree.ads: Minor reformatting
+ Indicate that Flag2 also applies to N_With_Clause (Is_Extending_All).
+
+2004-01-23 Ed Schonberg <schonberg@gnat.com>
+
+ * sem_ch13.adb (Analyze_Attribute_Definition_Clause): If the attribute
+ applies to a type with an incomplete view, use full view in Name of
+ clause, for consistency with uses of Get_Attribute_Definition_Clause.
+
+2004-01-23 Arnaud Charlet <charlet@act-europe.fr>
+
+ * 5itaprop.adb (Set_Priority): Reset the priority to 0 when using
+ SCHED_RR, since other values are not supported by this policy.
+ (Initialize): Move initialization of mutex attribute to package
+ elaboration, to prevent early access to this variable.
+
+ * Makefile.in: Remove mention of Makefile.adalib, unused.
+
+ * Makefile.adalib: Removed, unused.
+
2004-01-21 Javier Miranda <miranda@gnat.com>
* exp_aggr.adb (Build_Record_Aggr_Code): Do not build the master
diff --git a/gcc/ada/Makefile.adalib b/gcc/ada/Makefile.adalib
deleted file mode 100644
index ba084dcfbbd..00000000000
--- a/gcc/ada/Makefile.adalib
+++ /dev/null
@@ -1,122 +0,0 @@
-# This is the Unix/NT makefile used to build an alternate GNAT run-time.
-# Note that no files in the original GNAT library dirctory will be
-# modified by this procedure
-#
-# This Makefile requires Gnu make.
-# Here is how to use this Makefile
-#
-# 1. Create a new directory (say adalib)
-# e.g. $ mkdir adalib
-# $ cd adalib
-#
-# 2. Copy this Makefile from the standard Adalib directory, e.g.
-# $ cp /usr/local/gnat/lib/gcc-lib/<target>/<version>/adalib/Makefile.adalib .
-#
-# 3. If needed (e.g for pragma Normalize_Scalars), create a gnat.adc
-# containing the configuration pragmas you want to use to build the library
-# e.g. $ echo pragma Normalize_Scalars; > gnat.adc
-# Note that this step is usually not needed, and most pragmas are not
-# relevant to the GNAT run time.
-#
-# 4. Determine the values of the following MACROS
-# ROOT (location of GNAT installation, e.g /usr/local/gnat)
-# and optionnally
-# CFLAGS (back end compilation flags such as -g -O2)
-# ADAFLAGS (front end compilation flags such as -gnatpgn)
-# *beware* the minimum value for this MACRO is -gnatpg
-# for proper compilation of the GNAT library
-# 5a. If you are using a native compile, call make
-# e.g. $ make -f Makefile.adalib ROOT=/usr/local/gnat CFLAGS="-g -O0"
-#
-# 5b. If you are using a cross compiler, you need to define two additional
-# MACROS:
-# CC (name of the cross compiler)
-# AR (name of the cross ar)
-#
-# e.g. $ make -f Makefile.adalib ROOT=/opt/gnu/gnat \
-# CFLAGS="-O2 -g -I/usr/wind/target/h" CC=powerpc-wrs-vxworks-gcc \
-# AR=arppc
-#
-# 6. put this new library on your Object PATH where you want to use it
-# in place of the original one. This can be achieved for instance by
-# updating the value of the environment variable ADA_OBJECTS_PATH
-
-PWD_COMMAND=$${PWDCMD-pwd}
-CC = gcc
-AR = ar
-
-ifeq ($(strip $(filter-out %sh,$(SHELL))),)
- GNAT_ROOT = $(shell cd $(ROOT);${PWD_COMMAND})/
-else
- GNAT_ROOT = $(ROOT)/
-endif
-
-target = $(shell $(CC) -dumpmachine)
-version = $(shell $(CC) -dumpversion)
-ADA_INCLUDE_PATH = $(GNAT_ROOT)lib/gcc-lib/$(target)/$(version)/adainclude/
-GCC_INCLUDE_PATH = $(GNAT_ROOT)lib/gcc-lib/$(target)/$(version)/gcc-include/
-ADA_OBJECTS_PATH = $(GNAT_ROOT)lib/gcc-lib/$(target)/$(version)/adalib/
-
-vpath %.adb $(ADA_INCLUDE_PATH)
-vpath %.ads $(ADA_INCLUDE_PATH)
-vpath %.c $(ADA_INCLUDE_PATH)
-vpath %.h $(ADA_INCLUDE_PATH)
-
-CFLAGS = -O2
-GNATLIBCFLAGS = -DIN_RTS=1 -DIN_GCC=1 -fexceptions
-ADAFLAGS = -gnatpgn
-ALL_ADAFLAGS = $(CFLAGS) $(ADAFLAGS) -I.
-FORCE_DEBUG_ADAFLAGS = -g
-INCLUDES = -I$(ADA_INCLUDE_PATH) -I$(GCC_INCLUDE_PATH)/include \
--I$(GCC_INCLUDE_PATH)/gcc/config -I$(GCC_INCLUDE_PATH)/gcc \
--I$(GCC_INCLUDE_PATH)/gcc/ada -I$(GCC_INCLUDE_PATH)
-
-# Say how to compile Ada programs.
-.SUFFIXES: .ada .adb .ads
-
-.c.o:
- $(CC) -c $(CFLAGS) $(GNATLIBCFLAGS) $(INCLUDES) $<
-.adb.o:
- $(CC) -c $(ALL_ADAFLAGS) $<
-.ads.o:
- $(CC) -c $(ALL_ADAFLAGS) $<
-
-GNAT_OBJS :=$(filter-out __%,$(shell $(AR) t $(ADA_OBJECTS_PATH)libgnat.a))
-GNARL_OBJS:=$(filter-out __%,$(shell $(AR) t $(ADA_OBJECTS_PATH)libgnarl.a))
-OBJS := $(GNAT_OBJS) $(GNARL_OBJS)
-
-all: libgnat.a libgnarl.a delete_objects g-trasym.o
- chmod 0444 *.ali *.a
-
-delete_objects:
- rm *.o
-
-libgnat.a: $(GNAT_OBJS)
- $(AR) r libgnat.a $(GNAT_OBJS)
-
-libgnarl.a: $(GNARL_OBJS)
- $(AR) r libgnarl.a $(GNARL_OBJS)
-
-a-except.o: a-except.adb a-except.ads
- $(CC) -c $(FORCE_DEBUG_ADAFLAGS) $(ALL_ADAFLAGS) -O0 -fno-inline $<
-
-s-assert.o: s-assert.adb s-assert.ads a-except.ads
- $(CC) -c $(FORCE_DEBUG_ADAFLAGS) $(ALL_ADAFLAGS) $<
-
-s-tasdeb.o: s-tasdeb.adb
- $(CC) -c $(FORCE_DEBUG_ADAFLAGS) $(ALL_ADAFLAGS) $<
-
-s-vaflop.o: s-vaflop.adb
- $(CC) -c $(FORCE_DEBUG_ADAFLAGS) -O $(ALL_ADAFLAGS) $<
-
-s-memory.o: s-memory.adb s-memory.ads
- $(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 $(ADA_INCLUDES) $<
-
-s-traceb.o: s-traceb.adb
- $(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -fno-optimize-sibling-calls $(ADA_INCLUDES) $<
-
-tracebak.o: tracebak.c
- $(CC) -c $(CFLAGS) $(GNATLIBCFLAGS) \
- $(ALL_CPPFLAGS) $(INCLUDES) -fno-omit-frame-pointer $<
-
-.PHONY: delete_objects
diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in
index ee2da91e8ca..7252bc04138 100644
--- a/gcc/ada/Makefile.in
+++ b/gcc/ada/Makefile.in
@@ -1451,7 +1451,7 @@ RAVEN_OBJS = \
ADA_INCLUDE_SRCS =\
ada.ads calendar.ads directio.ads gnat.ads interfac.ads ioexcept.ads \
machcode.ads text_io.ads unchconv.ads unchdeal.ads \
- sequenio.ads system.ads Makefile.adalib Makefile.prolog Makefile.generic \
+ sequenio.ads system.ads Makefile.prolog Makefile.generic \
memtrack.adb \
a-*.adb a-*.ads g-*.ad? i-*.ad? \
s-[a-o]*.adb s-[p-z]*.adb \
@@ -1706,13 +1706,13 @@ install-gnatlib: ../stamp-gnatlib
# for shared libraries on some targets, e.g. on HP-UX where the x
# permission is required.
for file in gnat gnarl; do \
- if [ -f rts/lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) ]; then \
- $(INSTALL) rts/lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) \
+ if [ -f rts/lib$${file}$(hyphen)$(LIBRARY_VERSION)$(soext) ]; then \
+ $(INSTALL) rts/lib$${file}$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(DESTDIR)$(ADA_RTL_OBJ_DIR); \
fi; \
- if [ -f rts/lib$$file$(soext) ]; then \
- $(LN_S) lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) \
- $(DESTDIR)$(ADA_RTL_OBJ_DIR)/lib$$file$(soext); \
+ if [ -f rts/lib$${file}$(soext) ]; then \
+ $(LN_S) lib$${file}$(hyphen)$(LIBRARY_VERSION)$(soext) \
+ $(DESTDIR)$(ADA_RTL_OBJ_DIR)/lib$${file}$(soext); \
fi; \
done
# This copy must be done preserving the date on the original file.
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index 1b0200e2c78..41669d097c6 100644
--- a/gcc/ada/decl.c
+++ b/gcc/ada/decl.c
@@ -82,6 +82,7 @@ static struct incomplete
Entity_Id full_type;
} *defer_incomplete_list = 0;
+static void copy_alias_set (tree, tree);
static tree substitution_list (Entity_Id, Entity_Id, tree, int);
static int allocatable_size_p (tree, int);
static struct attrib *build_attr_list (Entity_Id);
@@ -1605,13 +1606,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tem = build_array_type (tem, gnu_index_types[index]);
TYPE_MULTI_ARRAY_P (tem) = (index > 0);
- /* ??? For now, we say that any component of aggregate type is
- addressable because the front end may take 'Reference of it.
- But we have to make it addressable if it must be passed by
- reference or it that is the default. */
+ /* If the type below this an multi-array type, then this
+ does not not have aliased components.
+
+ ??? Otherwise, for now, we say that any component of aggregate
+ type is addressable because the front end may take 'Reference
+ of it. But we have to make it addressable if it must be passed
+ by reference or it that is the default. */
TYPE_NONALIASED_COMPONENT (tem)
- = (! Has_Aliased_Components (gnat_entity)
- && ! AGGREGATE_TYPE_P (TREE_TYPE (tem)));
+ = ((TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE
+ && TYPE_MULTI_ARRAY_P (TREE_TYPE (tem))) ? 1
+ : (! Has_Aliased_Components (gnat_entity)
+ && ! AGGREGATE_TYPE_P (TREE_TYPE (tem))));
}
/* If an alignment is specified, use it if valid. But ignore it for
@@ -1923,13 +1929,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{
gnu_type = build_array_type (gnu_type, gnu_index_type[index]);
TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
- /* ??? For now, we say that any component of aggregate type is
- addressable because the front end may take 'Reference.
- But we have to make it addressable if it must be passed by
- reference or it that is the default. */
+ /* If the type below this an multi-array type, then this
+ does not not have aliased components.
+
+ ??? Otherwise, for now, we say that any component of aggregate
+ type is addressable because the front end may take 'Reference
+ of it. But we have to make it addressable if it must be passed
+ by reference or it that is the default. */
TYPE_NONALIASED_COMPONENT (gnu_type)
- = (! Has_Aliased_Components (gnat_entity)
- && ! AGGREGATE_TYPE_P (TREE_TYPE (gnu_type)));
+ = ((TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
+ && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type))) ? 1
+ : (! Has_Aliased_Components (gnat_entity)
+ && ! AGGREGATE_TYPE_P (TREE_TYPE (gnu_type))));
}
/* If we are at file level and this is a multi-dimensional array, we
@@ -2010,8 +2021,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Set our alias set to that of our base type. This gives all
array subtypes the same alias set. */
- TYPE_ALIAS_SET (gnu_type) = get_alias_set (gnu_base_type);
- record_component_aliases (gnu_type);
+ copy_alias_set (gnu_type, gnu_base_type);
}
/* If this is a packed type, make this type the same as the packed
@@ -2408,11 +2418,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (Etype (gnat_entity) != gnat_entity
&& ! (Is_Private_Type (Etype (gnat_entity))
&& Full_View (Etype (gnat_entity)) == gnat_entity))
- {
- TYPE_ALIAS_SET (gnu_type)
- = get_alias_set (gnat_to_gnu_type (Etype (gnat_entity)));
- record_component_aliases (gnu_type);
- }
+ copy_alias_set (gnu_type, gnat_to_gnu_type (Etype (gnat_entity)));
/* Fill in locations of fields. */
annotate_rep (gnat_entity, gnu_type);
@@ -2644,8 +2650,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_base_type);
TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_base_type);
SET_TYPE_ADA_SIZE (gnu_type, TYPE_ADA_SIZE (gnu_base_type));
- TYPE_ALIAS_SET (gnu_type) = get_alias_set (gnu_base_type);
- record_component_aliases (gnu_type);
+ copy_alias_set (gnu_type, gnu_base_type);
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
for (gnu_temp = gnu_subst_list;
@@ -4144,6 +4149,30 @@ mark_out_of_scope (Entity_Id gnat_entity)
}
}
+/* Set the alias set of GNU_NEW_TYPE to be that of GNU_OLD_TYPE. If this
+ is a multi-dimensional array type, do this recursively. */
+
+static void
+copy_alias_set (tree gnu_new_type, tree gnu_old_type)
+{
+ if (TREE_CODE (gnu_new_type) == ARRAY_TYPE
+ && TREE_CODE (TREE_TYPE (gnu_new_type)) == ARRAY_TYPE
+ && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_new_type)))
+ {
+ /* We need to be careful here in case GNU_OLD_TYPE is an unconstrained
+ array. In that case, it doesn't have the same shape as GNU_NEW_TYPE,
+ so we need to go down to what does. */
+ if (TREE_CODE (gnu_old_type) == UNCONSTRAINED_ARRAY_TYPE)
+ gnu_old_type
+ = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_old_type))));
+
+ copy_alias_set (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type));
+ }
+
+ TYPE_ALIAS_SET (gnu_new_type) = get_alias_set (gnu_old_type);
+ record_component_aliases (gnu_new_type);
+}
+
/* Return a TREE_LIST describing the substitutions needed to reflect
discriminant substitutions from GNAT_SUBTYPE to GNAT_TYPE and add
them to GNU_LIST. If GNAT_TYPE is not specified, use the base type
@@ -4543,7 +4572,7 @@ make_aligning_type (tree type, int align, tree size)
bitsize_int (align));
TYPE_SIZE_UNIT (record_type)
= size_binop (PLUS_EXPR, size, size_int (align / BITS_PER_UNIT));
- TYPE_ALIAS_SET (record_type) = get_alias_set (type);
+ copy_alias_set (record_type, type);
return record_type;
}
@@ -4610,7 +4639,7 @@ make_packable_type (tree type)
}
finish_record_type (new_type, nreverse (field_list), 1, 1);
- TYPE_ALIAS_SET (new_type) = get_alias_set (type);
+ copy_alias_set (new_type, type);
return TYPE_MODE (new_type) == BLKmode ? type : new_type;
}
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 7113102095b..1a1b54ab497 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1918,14 +1918,13 @@ package body Exp_Aggr is
Comp := First (Component_Associations (N));
while Present (Comp) loop
- Selector := Entity (First (Choices (Comp)));
+ Selector := Entity (First (Choices (Comp)));
-- Ada0Y (AI-287): Default initialization of a limited component
if Box_Present (Comp)
and then Is_Limited_Type (Etype (Selector))
then
-
-- Ada0Y (AI-287): If the component type has tasks then generate
-- the activation chain and master entities (except in case of an
-- allocator because in that case these entities are generated
@@ -1949,6 +1948,7 @@ package body Exp_Aggr is
if not Inside_Init_Proc and not Inside_Allocator then
Build_Activation_Chain_Entity (N);
+
if not Has_Master_Entity (Current_Scope) then
Build_Master_Entity (Etype (N));
end if;
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 39a1f31bdec..76afc7b1495 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -1198,7 +1198,8 @@ package body Exp_Ch9 is
Loc : constant Source_Ptr := Sloc (E);
P : Node_Id;
Decl : Node_Id;
- S : Entity_Id := Scope (E);
+ S : Entity_Id;
+
begin
-- Ada0Y (AI-287): Do not set/get the has_master_entity reminder in
-- internal scopes. Required for nested limited aggregates.
@@ -1213,12 +1214,13 @@ package body Exp_Ch9 is
then
return;
end if;
- else
- -- Ada0Y (AI-287): Similar to the Ãprevious casebut skipping internal
- -- scopes. If we are not inside an internal scope this code is
- -- equivalent to the previous code.
+ else
+ -- Ada0Y (AI-287): Similar to the previous case but skipping
+ -- internal scopes. If we are not inside an internal scope this
+ -- code is equivalent to the previous code.
+ S := Scope (E);
while Is_Internal (S) loop
S := Scope (S);
end loop;
@@ -1228,7 +1230,6 @@ package body Exp_Ch9 is
then
return;
end if;
-
end if;
-- Otherwise first build the master entity
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index 36b4b36b97c..f86ab6e8c27 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -791,6 +791,12 @@ package body Exp_Pakd is
Set_Has_Delayed_Freeze (PAT, False);
Set_Has_Delayed_Freeze (Etype (PAT), False);
+
+ -- If we did allocate a freeze node, then clear out the reference
+ -- since it is obsolete (should we delete the freeze node???)
+
+ Set_Freeze_Node (PAT, Empty);
+ Set_Freeze_Node (Etype (PAT), Empty);
end Install_PAT;
-----------------
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index f716fe74b90..882fe6cab9a 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -862,7 +862,7 @@ package body Make is
begin
Add_Lib_Search_Dir (N);
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Adding object directory """);
Write_Str (N);
Write_Str (""".");
@@ -878,7 +878,7 @@ package body Make is
begin
Add_Src_Search_Dir (N);
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Adding source directory """);
Write_Str (N);
Write_Str (""".");
@@ -1037,7 +1037,7 @@ package body Make is
-- modified.
begin
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str (" Adding ");
Write_Line (Argv);
end if;
@@ -1059,7 +1059,7 @@ package body Make is
-- We need a copy, because Name_Buffer may be modified
begin
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str (" Adding ");
Write_Line (Argv);
end if;
@@ -1317,11 +1317,11 @@ package body Make is
if Read_Only then
declare
Saved_Check_Object_Consistency : constant Boolean :=
- Opt.Check_Object_Consistency;
+ Check_Object_Consistency;
begin
- Opt.Check_Object_Consistency := False;
+ Check_Object_Consistency := False;
Text := Read_Library_Info (Lib_File);
- Opt.Check_Object_Consistency := Saved_Check_Object_Consistency;
+ Check_Object_Consistency := Saved_Check_Object_Consistency;
end;
else
@@ -1384,7 +1384,7 @@ package body Make is
-- Don't take Ali file into account if it was generated without
-- object.
- if Opt.Operating_Mode /= Opt.Check_Semantics
+ if Operating_Mode /= Check_Semantics
and then ALIs.Table (ALI).No_Object
then
Verbose_Msg (Full_Lib_File, "has no corresponding object");
@@ -1394,7 +1394,7 @@ package body Make is
-- Check for matching compiler switches if needed
- if Opt.Check_Switches then
+ if Check_Switches then
-- First, collect all the switches
@@ -1465,7 +1465,7 @@ package body Make is
end loop;
if not Switch_Found then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Verbose_Msg (ALIs.Table (ALI).Sfile,
"switch mismatch """ &
Switches_To_Check.Table (J).all & '"');
@@ -1480,7 +1480,7 @@ package body Make is
Integer (Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg -
Units.Table (ALIs.Table (ALI).First_Unit).First_Arg + 1)
then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Verbose_Msg (ALIs.Table (ALI).Sfile,
"different number of switches");
@@ -1516,7 +1516,7 @@ package body Make is
if Modified_Source /= No_File then
ALI := No_ALI_Id;
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Source_Name := Full_Source_Name (Modified_Source);
if Source_Name /= No_File then
@@ -1532,7 +1532,7 @@ package body Make is
if New_Spec /= No_File then
ALI := No_ALI_Id;
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Source_Name := Full_Source_Name (New_Spec);
if Source_Name /= No_File then
@@ -2545,14 +2545,14 @@ package body Make is
end if;
-- The following two flags affect the behavior of ALI.Set_Source_Table.
- -- We set Opt.Check_Source_Files to True to ensure that source file
- -- time stamps are checked, and we set Opt.All_Sources to False to
+ -- We set Check_Source_Files to True to ensure that source file
+ -- time stamps are checked, and we set All_Sources to False to
-- avoid checking the presence of the source files listed in the
-- source dependency section of an ali file (which would be a mistake
-- since the ali file may be obsolete).
- Opt.Check_Source_Files := True;
- Opt.All_Sources := False;
+ Check_Source_Files := True;
+ All_Sources := False;
Insert_Q (Main_Source);
Mark (Main_Source);
@@ -2764,22 +2764,22 @@ package body Make is
declare
Saved_Object_Consistency : constant Boolean :=
- Opt.Check_Object_Consistency;
+ Check_Object_Consistency;
begin
-- If compilation was not OK, or if output is not an
-- object file and we don't do the bind step, don't check
-- for object consistency.
- Opt.Check_Object_Consistency :=
- Opt.Check_Object_Consistency
+ Check_Object_Consistency :=
+ Check_Object_Consistency
and Compilation_OK
and (Output_Is_Object or Do_Bind_Step);
Text := Read_Library_Info (Lib_File);
-- Restore Check_Object_Consistency to its initial value
- Opt.Check_Object_Consistency := Saved_Object_Consistency;
+ Check_Object_Consistency := Saved_Object_Consistency;
end;
-- If an ALI file was generated by this compilation, scan
@@ -2808,7 +2808,7 @@ package body Make is
-- If we could not read the ALI file that was just generated
-- then there could be a problem reading either the ALI or the
- -- corresponding object file (if Opt.Check_Object_Consistency
+ -- corresponding object file (if Check_Object_Consistency
-- is set Read_Library_Info checks that the time stamp of the
-- object file is more recent than that of the ALI). For an
-- example of problems caught by this test see [6625-009].
@@ -2870,7 +2870,7 @@ package body Make is
-- If we have a special runtime, we add the standard
-- library only if we can find it.
- if Opt.RTS_Switch then
+ if RTS_Switch then
Add_It := Find_File (Sfile, Osint.Source) /= No_File;
end if;
@@ -2927,7 +2927,7 @@ package body Make is
end if;
end loop;
- if Opt.Display_Compilation_Progress then
+ if Display_Compilation_Progress then
Write_Str ("completed ");
Write_Int (Int (Q_Front));
Write_Str (" out of ");
@@ -3158,7 +3158,7 @@ package body Make is
if (not Debug.Debug_Flag_N) and Main_Project /= No_Project then
for Project in 1 .. Projects.Last loop
if Projects.Table (Project).Config_File_Temp then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Deleting temp configuration file """);
Write_Str (Get_Name_String
(Projects.Table (Project).Config_File_Name));
@@ -3405,7 +3405,7 @@ package body Make is
-- Do not check for an object file (".o") when compiling to
-- Java bytecode since ".class" files are generated instead.
- Opt.Check_Object_Consistency := False;
+ Check_Object_Consistency := False;
end if;
-- Special case when switch -B was specified
@@ -3734,7 +3734,7 @@ package body Make is
end if;
end if;
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Eol;
Write_Str ("GNATMAKE ");
Write_Str (Gnatvsn.Gnat_Version_String);
@@ -3778,8 +3778,8 @@ package body Make is
-- If -M was specified, behave as if -n was specified
- if Opt.List_Dependencies then
- Opt.Do_Not_Execute := True;
+ if List_Dependencies then
+ Do_Not_Execute := True;
end if;
-- Note that Osint.Next_Main_Source will always return the (possibly
@@ -3791,7 +3791,7 @@ package body Make is
Add_Switch ("-I-", Compiler, And_Save => True);
if Main_Project = No_Project then
- if Opt.Look_In_Primary_Dir then
+ if Look_In_Primary_Dir then
Add_Switch
("-I" &
@@ -3815,13 +3815,13 @@ package body Make is
-- sources for other compilation units, when there are extending
-- projects.
- Opt.Look_In_Primary_Dir := False;
+ Look_In_Primary_Dir := False;
end if;
-- If the user wants a program without a main subprogram, add the
-- appropriate switch to the binder.
- if Opt.No_Main_Subprogram then
+ if No_Main_Subprogram then
Add_Switch ("-z", Binder, And_Save => True);
end if;
@@ -3951,7 +3951,7 @@ package body Make is
-- We only output the main source file if there is only one
- if Opt.Verbose_Mode and then Osint.Number_Of_Files = 1 then
+ if Verbose_Mode and then Osint.Number_Of_Files = 1 then
Write_Str ("Main source file: """);
Write_Str (Main_Unit_File_Name
(Pos + 1 .. Main_Unit_File_Name'Last));
@@ -3971,7 +3971,7 @@ package body Make is
-- switches (if any).
if Osint.Number_Of_Files = 1 then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Adding gnatmake switches for """);
Write_Str (Main_Unit_File_Name);
Write_Line (""".");
@@ -4004,7 +4004,7 @@ package body Make is
begin
if Defaults /= Nil_Variable_Value then
- if (not Opt.Quiet_Output)
+ if (not Quiet_Output)
and then Switches /= No_Array_Element
then
Write_Line
@@ -4020,7 +4020,7 @@ package body Make is
The_Package => Builder_Package,
Program => None);
- elsif (not Opt.Quiet_Output)
+ elsif (not Quiet_Output)
and then Switches /= No_Array_Element
then
Write_Line
@@ -4046,7 +4046,7 @@ package body Make is
-- Add binder switches from the project file for the first main
if Do_Bind_Step and Binder_Package /= No_Package then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Adding binder switches for """);
Write_Str (Main_Unit_File_Name);
Write_Line (""".");
@@ -4061,7 +4061,7 @@ package body Make is
-- Add linker switches from the project file for the first main
if Do_Link_Step and Linker_Package /= No_Package then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Adding linker switches for""");
Write_Str (Main_Unit_File_Name);
Write_Line (""".");
@@ -4087,7 +4087,7 @@ package body Make is
Make_Failed ("*** make failed.");
end;
- Display_Commands (not Opt.Quiet_Output);
+ Display_Commands (not Quiet_Output);
Check_Steps;
@@ -4104,7 +4104,7 @@ package body Make is
not MLib.Tgt.Library_Exists_For (Proj);
if Projects.Table (Proj).Flag1 then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str
("Library file does not exist for project """);
Write_Str
@@ -4280,7 +4280,7 @@ package body Make is
-- precedence.
if Saved_Maximum_Processes = 0 then
- Saved_Maximum_Processes := Opt.Maximum_Processes;
+ Saved_Maximum_Processes := Maximum_Processes;
end if;
-- Allocate as many temporary mapping file names as the maximum
@@ -4470,15 +4470,15 @@ package body Make is
Most_Recent_Obj_Stamp => Youngest_Obj_Stamp,
Main_Unit => Is_Main_Unit,
Compilation_Failures => Compilation_Failures,
- Check_Readonly_Files => Opt.Check_Readonly_Files,
- Do_Not_Execute => Opt.Do_Not_Execute,
- Force_Compilations => Opt.Force_Compilations,
- In_Place_Mode => Opt.In_Place_Mode,
- Keep_Going => Opt.Keep_Going,
+ Check_Readonly_Files => Check_Readonly_Files,
+ Do_Not_Execute => Do_Not_Execute,
+ Force_Compilations => Force_Compilations,
+ In_Place_Mode => In_Place_Mode,
+ Keep_Going => Keep_Going,
Initialize_ALI_Data => True,
Max_Process => Saved_Maximum_Processes);
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("End of compilation");
Write_Eol;
end if;
@@ -4491,7 +4491,7 @@ package body Make is
Total_Compilation_Failures + Compilation_Failures;
if Total_Compilation_Failures /= 0 then
- if Opt.Keep_Going then
+ if Keep_Going then
goto Next_Main;
else
@@ -4563,7 +4563,7 @@ package body Make is
end loop;
end if;
- if Opt.List_Dependencies then
+ if List_Dependencies then
if First_Compiled_File /= No_File then
Inform
(First_Compiled_File,
@@ -4574,13 +4574,13 @@ package body Make is
elsif First_Compiled_File = No_File
and then not Do_Bind_Step
- and then not Opt.Quiet_Output
+ and then not Quiet_Output
and then not Library_Rebuilt
and then Osint.Number_Of_Files = 1
then
Inform (Msg => "objects up to date.");
- elsif Opt.Do_Not_Execute
+ elsif Do_Not_Execute
and then First_Compiled_File /= No_File
then
Write_Name (First_Compiled_File);
@@ -4598,8 +4598,8 @@ package body Make is
-- 4) Made unit cannot be a main unit
- if (Opt.Do_Not_Execute
- or Opt.List_Dependencies
+ if (Do_Not_Execute
+ or List_Dependencies
or not Do_Bind_Step
or not Is_Main_Unit)
and then not No_Main_Subprogram
@@ -4659,7 +4659,7 @@ package body Make is
-- and otherwise motivate the relink/rebind.
if not Executable_Obsolete then
- if not Opt.Quiet_Output then
+ if not Quiet_Output then
Inform (Executable, "up to date.");
end if;
@@ -4722,7 +4722,7 @@ package body Make is
-- library path. In this case, use the corresponding library file
-- name.
- if Main_ALI_File = No_File and then Opt.In_Place_Mode then
+ if Main_ALI_File = No_File and then In_Place_Mode then
Get_Name_String (Get_Directory (Full_Source_Name (Src_File)));
Get_Name_String_And_Append (ALI_File);
Main_ALI_File := Name_Find;
@@ -5300,7 +5300,7 @@ package body Make is
exception
when Link_Failed =>
- if Osint.Number_Of_Files = 1 or not Opt.Keep_Going then
+ if Osint.Number_Of_Files = 1 or not Keep_Going then
raise;
else
@@ -5402,7 +5402,7 @@ package body Make is
-- if any.
if Do_Bind_Step and Binder_Package /= No_Package then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Adding binder switches for """);
Write_Str (Main_Unit_File_Name);
Write_Line (""".");
@@ -5418,7 +5418,7 @@ package body Make is
-- if any.
if Do_Link_Step and Linker_Package /= No_Package then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Adding linker switches for""");
Write_Str (Main_Unit_File_Name);
Write_Line (""".");
@@ -5649,7 +5649,7 @@ package body Make is
-- GNATMAKE since we do not need to check source consistency
-- again once GNATMAKE has looked at the sources to check.
- Opt.Check_Object_Consistency := True;
+ Check_Object_Consistency := True;
-- Package initializations. The order of calls is important here.
@@ -5689,14 +5689,14 @@ package body Make is
-- Test for trailing -o switch
- elsif Opt.Output_File_Name_Present
+ elsif Output_File_Name_Present
and then not Output_File_Name_Seen
then
Make_Failed ("output file name missing after -o");
-- Test for trailing -D switch
- elsif Opt.Object_Directory_Present
+ elsif Object_Directory_Present
and then not Object_Directory_Seen then
Make_Failed ("object directory missing after -D");
end if;
@@ -5730,7 +5730,7 @@ package body Make is
-- A project file was specified by a -P switch
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Eol;
Write_Str ("Parsing Project File """);
Write_Str (Project_File_Name.all);
@@ -5740,7 +5740,7 @@ package body Make is
-- Avoid looking in the current directory for ALI files
- -- Opt.Look_In_Primary_Dir := False;
+ -- Look_In_Primary_Dir := False;
-- Set the project parsing verbosity to whatever was specified
-- by a possible -vP switch.
@@ -5759,7 +5759,7 @@ package body Make is
Make_Failed ("""", Project_File_Name.all, """ processing failed");
end if;
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Eol;
Write_Str ("Parsing of Project File """);
Write_Str (Project_File_Name.all);
@@ -5941,7 +5941,7 @@ package body Make is
-- is not marked.
if Sfile /= No_Name and then not Is_Marked (Sfile) then
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Adding """);
Write_Str (Get_Name_String (Sfile));
Write_Line (""" to the queue");
@@ -5959,7 +5959,7 @@ package body Make is
-- queue. This will allow parallel compilation processes if -jx
-- switch is used.
- if Opt.Verbose_Mode then
+ if Verbose_Mode then
Write_Str ("Adding """);
Write_Str (Get_Name_String (Sfile));
Write_Line (""" as if on the command line");
@@ -6229,7 +6229,7 @@ package body Make is
-- We have to provide the full library file name in In_Place_Mode
- if Opt.In_Place_Mode then
+ if In_Place_Mode then
Lib_Name := Full_Lib_File_Name (Lib_Name);
end if;
@@ -6249,7 +6249,7 @@ package body Make is
then
null;
else
- if not Opt.Quiet_Output then
+ if not Quiet_Output then
Src_Name := Full_Source_Name (Src_Name);
end if;
@@ -6479,7 +6479,7 @@ package body Make is
-- flag (that is we have seen a -o), then the next argument is
-- the name of the output executable.
- elsif Opt.Output_File_Name_Present
+ elsif Output_File_Name_Present
and then not Output_File_Name_Seen
then
Output_File_Name_Seen := True;
@@ -6511,7 +6511,7 @@ package body Make is
-- (that is we have seen a -D), then the next argument is
-- the path name of the object directory..
- elsif Opt.Object_Directory_Present
+ elsif Object_Directory_Present
and then not Object_Directory_Seen
then
Object_Directory_Seen := True;
@@ -6581,7 +6581,7 @@ package body Make is
if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then
if Argv (3 .. Argv'Last) = "-" then
- Opt.Look_In_Primary_Dir := False;
+ Look_In_Primary_Dir := False;
elsif Program_Args = Compiler then
if Argv (3 .. Argv'Last) /= "-" then
@@ -6683,9 +6683,9 @@ package body Make is
-- Valid --RTS switch
- Opt.No_Stdinc := True;
- Opt.No_Stdlib := True;
- Opt.RTS_Switch := True;
+ No_Stdinc := True;
+ No_Stdlib := True;
+ RTS_Switch := True;
declare
Src_Path_Name : constant String_Ptr :=
@@ -6737,7 +6737,7 @@ package body Make is
-- -I-
elsif Argv (2 .. Argv'Last) = "I-" then
- Opt.Look_In_Primary_Dir := False;
+ Look_In_Primary_Dir := False;
-- Forbid -?- or -??- where ? is any character
@@ -6835,7 +6835,7 @@ package body Make is
elsif Argv (2) = 'd'
and then Argv'Last = 2
then
- Opt.Display_Compilation_Progress := True;
+ Display_Compilation_Progress := True;
-- -i
@@ -6862,7 +6862,7 @@ package body Make is
elsif Argv (2) = 'm'
and then Argv'Last = 2
then
- Opt.Minimal_Recompilation := True;
+ Minimal_Recompilation := True;
-- -u
@@ -6870,7 +6870,7 @@ package body Make is
and then Argv'Last = 2
then
Unique_Compile := True;
- Opt.Compile_Only := True;
+ Compile_Only := True;
Do_Bind_Step := False;
Do_Link_Step := False;
@@ -6881,7 +6881,7 @@ package body Make is
then
Unique_Compile_All_Projects := True;
Unique_Compile := True;
- Opt.Compile_Only := True;
+ Compile_Only := True;
Do_Bind_Step := False;
Do_Link_Step := False;
@@ -6962,9 +6962,9 @@ package body Make is
-- step are not executed.
Add_Switch (Argv, Compiler, And_Save => And_Save);
- Opt.Operating_Mode := Opt.Check_Semantics;
- Opt.Check_Object_Consistency := False;
- Opt.Compile_Only := True;
+ Operating_Mode := Check_Semantics;
+ Check_Object_Consistency := False;
+ Compile_Only := True;
Do_Bind_Step := False;
Do_Link_Step := False;
@@ -6973,7 +6973,7 @@ package body Make is
-- Don't pass -nostdlib to gnatlink, it will disable
-- linking with all standard library files.
- Opt.No_Stdlib := True;
+ No_Stdlib := True;
Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Binder, And_Save => And_Save);
@@ -6982,19 +6982,20 @@ package body Make is
-- Pass -nostdinc to the Compiler and to gnatbind
- Opt.No_Stdinc := True;
+ No_Stdinc := True;
Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Binder, And_Save => And_Save);
-- By default all switches with more than one character
-- or one character switches which are not in 'a' .. 'z'
- -- (except 'C', 'F', and 'M') are passed to the compiler,
+ -- (except 'C', 'F', 'M' and 'B') are passed to the compiler,
-- unless we are dealing with a debug switch (starts with 'd')
elsif Argv (2) /= 'd'
and then Argv (2 .. Argv'Last) /= "C"
and then Argv (2 .. Argv'Last) /= "F"
and then Argv (2 .. Argv'Last) /= "M"
+ and then Argv (2 .. Argv'Last) /= "B"
and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z')
then
Add_Switch (Argv, Compiler, And_Save => And_Save);
@@ -7214,7 +7215,7 @@ package body Make is
Prefix : String := " -> ")
is
begin
- if not Opt.Verbose_Mode then
+ if not Verbose_Mode then
return;
end if;
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index 1aa4725e46c..2415a3f31d1 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2004 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- --
@@ -26,7 +26,7 @@
with Err_Vars; use Err_Vars;
with Namet; use Namet;
-with Opt;
+with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
with Prj.Com; use Prj.Com;
@@ -167,6 +167,7 @@ package body Prj.Part is
procedure Parse_Single_Project
(Project : out Project_Node_Id;
+ Extends_All : out Boolean;
Path_Name : String;
Extended : Boolean;
From_Extended : Extension_Origin);
@@ -431,6 +432,7 @@ package body Prj.Part is
Store_Comments : Boolean := False)
is
Current_Directory : constant String := Get_Current_Dir;
+ Dummy : Boolean;
begin
-- Save the Packages_To_Check in Prj, so that it is visible from
@@ -467,6 +469,7 @@ package body Prj.Part is
Parse_Single_Project
(Project => Project,
+ Extends_All => Dummy,
Path_Name => Path_Name,
Extended => False,
From_Extended => None);
@@ -678,6 +681,7 @@ package body Prj.Part is
Current_With : With_Record;
Limited_With : Boolean := False;
+ Extends_All : Boolean := False;
begin
Imported_Projects := Empty_Node;
@@ -775,9 +779,13 @@ package body Prj.Part is
if Withed_Project = Empty_Node then
Parse_Single_Project
(Project => Withed_Project,
+ Extends_All => Extends_All,
Path_Name => Imported_Path_Name,
Extended => False,
From_Extended => From_Extended);
+
+ else
+ Extends_All := Is_Extending_All (Withed_Project);
end if;
if Withed_Project = Empty_Node then
@@ -805,6 +813,10 @@ package body Prj.Part is
Name_Len := Imported_Path_Name'Length;
Name_Buffer (1 .. Name_Len) := Imported_Path_Name;
Set_Path_Name_Of (Current_Project, Name_Find);
+
+ if Extends_All then
+ Set_Is_Extending_All (Current_Project);
+ end if;
end if;
end if;
end;
@@ -817,6 +829,7 @@ package body Prj.Part is
procedure Parse_Single_Project
(Project : out Project_Node_Id;
+ Extends_All : out Boolean;
Path_Name : String;
Extended : Boolean;
From_Extended : Extension_Origin)
@@ -843,6 +856,8 @@ package body Prj.Part is
Project_Comment_State : Tree.Comment_State;
begin
+ Extends_All := False;
+
declare
Normed : String := Normalize_Pathname (Path_Name);
begin
@@ -908,6 +923,8 @@ package body Prj.Part is
end if;
elsif A_Project_Name_And_Node.Extended then
+ Extends_All := Is_Extending_All (A_Project_Name_And_Node.Node);
+
-- If the imported project is an extended project A, and we are
-- in an extended project, replace A with the ultimate project
-- extending A.
@@ -1136,13 +1153,14 @@ package body Prj.Part is
-- Make sure that gnatmake will use mapping files
- Opt.Create_Mapping_File := True;
+ Create_Mapping_File := True;
-- We are extending another project
Scan; -- scan past EXTENDS
if Token = Tok_All then
+ Extends_All := True;
Set_Is_Extending_All (Project);
Scan; -- scan past ALL
end if;
@@ -1196,6 +1214,7 @@ package body Prj.Part is
Parse_Single_Project
(Project => Extended_Project,
+ Extends_All => Extends_All,
Path_Name => Extended_Project_Path_Name,
Extended => True,
From_Extended => From_Extended);
@@ -1226,14 +1245,15 @@ package body Prj.Part is
With_Clause_Loop :
while With_Clause /= Empty_Node loop
Imported := Project_Node_Of (With_Clause);
- With_Clause := Next_With_Clause_Of (With_Clause);
- if Is_Extending_All (Imported) then
+ if Is_Extending_All (With_Clause) then
Error_Msg_Name_1 := Name_Of (Imported);
Error_Msg ("cannot import extending-all project {",
Token_Ptr);
exit With_Clause_Loop;
end if;
+
+ With_Clause := Next_With_Clause_Of (With_Clause);
end loop With_Clause_Loop;
end;
end if;
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index e75057a883d..bb550b1b538 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2004 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- --
@@ -817,8 +817,9 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id;
Report_Error : Put_Line_Access)
is
- Obj_Dir : Name_Id;
- Extending : Project_Id;
+ Obj_Dir : Name_Id;
+ Extending : Project_Id;
+ Extending2 : Project_Id;
begin
Error_Report := Report_Error;
@@ -861,7 +862,7 @@ package body Prj.Proc is
end if;
-- Check that no extended project shares its object directory with
- -- another project.
+ -- another extended project or with its extending project(s).
if Project /= No_Project then
for Extended in 1 .. Projects.Last loop
@@ -870,45 +871,95 @@ package body Prj.Proc is
if Extending /= No_Project then
Obj_Dir := Projects.Table (Extended).Object_Directory;
- for Prj in 1 .. Projects.Last loop
- if Prj /= Extended
- and then Projects.Table (Prj).Sources_Present
- and then Projects.Table (Prj).Object_Directory = Obj_Dir
+ -- Check that a project being extended does not share its
+ -- object directory with any project that extends it, directly
+ -- or indirectly, including a virtual extending project.
+
+ -- Start with the project directly extending it
+
+ Extending2 := Extending;
+
+ while Extending2 /= No_Project loop
+ if Projects.Table (Extending2).Sources_Present
+ and then
+ Projects.Table (Extending2).Object_Directory = Obj_Dir
then
- if Projects.Table (Extending).Virtual then
+ if Projects.Table (Extending2).Virtual then
Error_Msg_Name_1 := Projects.Table (Extended).Name;
if Error_Report = null then
Error_Msg
- ("project % cannot be extended by " &
- "a virtual project",
- Projects.Table (Extending).Location);
+ ("project % cannot be extended by a virtual " &
+ "project with the same object directory",
+ Projects.Table (Extended).Location);
else
Error_Report
("project """ &
Get_Name_String (Error_Msg_Name_1) &
- """ cannot be extended by a virtual project",
+ """ cannot be extended by a virtual " &
+ "project with the same object directory",
Project);
end if;
else
- Error_Msg_Name_1 := Projects.Table (Extending).Name;
+ Error_Msg_Name_1 :=
+ Projects.Table (Extending2).Name;
Error_Msg_Name_2 := Projects.Table (Extended).Name;
if Error_Report = null then
- Error_Msg ("project % cannot extend project %",
- Projects.Table (Extending).Location);
+ Error_Msg
+ ("project % cannot extend project %",
+ Projects.Table (Extending2).Location);
+ Error_Msg
+ ("\they share the same object directory",
+ Projects.Table (Extending2).Location);
else
Error_Report
("project """ &
Get_Name_String (Error_Msg_Name_1) &
""" cannot extend project """ &
- Get_Name_String (Error_Msg_Name_2) & '"',
+ Get_Name_String (Error_Msg_Name_2) & """",
+ Project);
+ Error_Report
+ ("they share the same object directory",
Project);
end if;
end if;
+ end if;
+
+ -- Continue with the next extending project, if any
+
+ Extending2 := Projects.Table (Extending2).Extended_By;
+ end loop;
+
+ -- Check that two projects being extended do not share their
+ -- project directories.
+
+ for Prj in Extended + 1 .. Projects.Last loop
+ Extending2 := Projects.Table (Prj).Extended_By;
+
+ if Extending2 /= No_Project
+ and then Projects.Table (Prj).Sources_Present
+ and then Projects.Table (Prj).Object_Directory = Obj_Dir
+ and then not Projects.Table (Extending).Virtual
+ then
+ Error_Msg_Name_1 := Projects.Table (Extending).Name;
+ Error_Msg_Name_2 := Projects.Table (Extended).Name;
+
+ if Error_Report = null then
+ Error_Msg ("project % cannot extend project %",
+ Projects.Table (Extending).Location);
+
+ else
+ Error_Report
+ ("project """ &
+ Get_Name_String (Error_Msg_Name_1) &
+ """ cannot extend project """ &
+ Get_Name_String (Error_Msg_Name_2) & '"',
+ Project);
+ end if;
Error_Msg_Name_1 := Projects.Table (Extended).Name;
Error_Msg_Name_2 := Projects.Table (Prj).Name;
@@ -924,7 +975,21 @@ package body Prj.Proc is
("project """ &
Get_Name_String (Error_Msg_Name_1) &
""" has the same object directory as project """ &
- Get_Name_String (Error_Msg_Name_2) & '"',
+ Get_Name_String (Error_Msg_Name_2) & """,",
+ Project);
+ end if;
+
+ Error_Msg_Name_1 := Projects.Table (Extending2).Name;
+
+ if Error_Report = null then
+ Error_Msg
+ ("\which is extended by project %",
+ Projects.Table (Extending).Location);
+
+ else
+ Error_Report
+ ("which is extended by project """ &
+ Get_Name_String (Error_Msg_Name_1) & '"',
Project);
end if;
diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb
index 735b3fee9e9..e8603c67bfb 100644
--- a/gcc/ada/prj-tree.adb
+++ b/gcc/ada/prj-tree.adb
@@ -933,7 +933,9 @@ package body Prj.Tree is
pragma Assert
(Node /= Empty_Node
and then
- Project_Nodes.Table (Node).Kind = N_Project);
+ (Project_Nodes.Table (Node).Kind = N_Project
+ or else
+ Project_Nodes.Table (Node).Kind = N_With_Clause));
return Project_Nodes.Table (Node).Flag2;
end Is_Extending_All;
@@ -1947,7 +1949,9 @@ package body Prj.Tree is
pragma Assert
(Node /= Empty_Node
and then
- Project_Nodes.Table (Node).Kind = N_Project);
+ (Project_Nodes.Table (Node).Kind = N_Project
+ or else
+ Project_Nodes.Table (Node).Kind = N_With_Clause));
Project_Nodes.Table (Node).Flag2 := True;
end Set_Is_Extending_All;
diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads
index 942c10be0b9..7192fcee796 100644
--- a/gcc/ada/prj-tree.ads
+++ b/gcc/ada/prj-tree.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2004 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- --
@@ -245,7 +245,7 @@ package Prj.Tree is
function Is_Extending_All (Node : Project_Node_Id) return Boolean;
pragma Inline (Is_Extending_All);
- -- Only valid for N_Project
+ -- Only valid for N_Project and N_With_Clause
function First_Variable_Of
(Node : Project_Node_Id) return Variable_Node_Id;
@@ -798,7 +798,7 @@ package Prj.Tree is
-- N_Project - it indicates that there are comments in the project
-- source that cannot be kept in the tree.
-- N_Project_Declaration
- -- - it indixates that there are unkept comment in the
+ -- - it indicates that there are unkept comments in the
-- project.
Flag2 : Boolean := False;
@@ -807,6 +807,9 @@ package Prj.Tree is
-- project.
-- N_Comment - it indicates that the comment is followed by an
-- empty line.
+ -- N_With_Clause
+ -- - it indicates that the originally imported project
+ -- is an extending all project.
Comments : Project_Node_Id := Empty_Node;
-- For nodes other that N_Comment_Zones or N_Comment, designates the
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index ca7ca0fb6c8..7e4428f7762 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
@@ -265,8 +265,14 @@ package body Sem_Ch13 is
U_Ent := Ent;
elsif Ekind (Ent) = E_Incomplete_Type then
+
+ -- The attribute applies to the full view, set the entity
+ -- of the attribute definition accordingly.
+
Ent := Underlying_Type (Ent);
U_Ent := Ent;
+ Set_Entity (Nam, Ent);
+
else
U_Ent := Underlying_Type (Ent);
end if;
@@ -3035,8 +3041,7 @@ package body Sem_Ch13 is
function Minimum_Size
(T : Entity_Id;
- Biased : Boolean := False)
- return Nat
+ Biased : Boolean := False) return Nat
is
Lo : Uint := No_Uint;
Hi : Uint := No_Uint;
@@ -3253,7 +3258,7 @@ package body Sem_Ch13 is
-- Build_Spec --
----------------
- function Build_Spec return Node_Id is
+ function Build_Spec return Node_Id is
begin
Subp_Id := Make_Defining_Identifier (Loc, Sname);
@@ -3327,7 +3332,7 @@ package body Sem_Ch13 is
-- Build_Spec --
----------------
- function Build_Spec return Node_Id is
+ function Build_Spec return Node_Id is
begin
Subp_Id := Make_Defining_Identifier (Loc, Sname);
@@ -3394,9 +3399,8 @@ package body Sem_Ch13 is
------------------------
function Rep_Item_Too_Early
- (T : Entity_Id;
- N : Node_Id)
- return Boolean
+ (T : Entity_Id;
+ N : Node_Id) return Boolean
is
begin
-- Cannot apply rep items that are not operational items
@@ -3446,8 +3450,7 @@ package body Sem_Ch13 is
function Rep_Item_Too_Late
(T : Entity_Id;
N : Node_Id;
- FOnly : Boolean := False)
- return Boolean
+ FOnly : Boolean := False) return Boolean
is
S : Entity_Id;
Parent_Type : Entity_Id;
OpenPOWER on IntegriCloud