Skip to content

R
riscv-gcc-1
Commit b7e429ab by Arnaud Charlet
Options

[multiple changes] 

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

	* 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.

From-SVN: r76403
parent 908f6e7c
Showing with 388 additions and 291 deletions
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;
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);
......
gcc/ada/ChangeLog
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
......
gcc/ada/Makefile.adalib deleted 100644 → 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
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.
......
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;
}
......
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;
......
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
......
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;
-----------------
......
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;
......
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;
......
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;
......
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;
......
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
......
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;
......
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