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 301 additions and 205 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/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